packages feed

jord 0.6.0.0 → 1.0.0.0

raw patch · 69 files changed

+6059/−4407 lines, 69 filesdep −haskelinenew-component:exe:jord-gen

Dependencies removed: haskeline

Files

ChangeLog.md view
@@ -1,50 +1,56 @@-### 0.6.0.0--- Fixed Ellipsoid: constructor expected inverseFlattening and not flattening--### 0.5.0.0--- Added Benchmarks-- Added GreatArc-- Added GreatArc from tuple of positions-- Added GreatArc from GreatCircle-- Added GreatArc from Track and Duration-- Added alongTrackDistance-- Added GreatArcs intersection--### 0.4.2.0--- Fixed intercept-- jord-exe renamed jord-repl--### 0.4.1.0--- Fixed interceptBySpeed-- Nautical miles symbol is "nm"-- REPL: intercept for intercept, interceptBySpeed and interceptByTime-- REPL: show length and speed in user selected unit--### 0.4.0.0--- Added ECEF, frames and delta to REPL-- Added Speed-- Added Duration-- Added Kinematics: course, position, CPA and intercept--### 0.3.1.0--- Added ECEF position-- Added Frames (Body, Local, North East Down)-- Added delta and target from position(s), frame and earth model-- Added earth models (WGS84, WGS72, GRS80 and derived spherical models)-- Builds against LTS 12.2 (GHC 8.4.3) and LTS 11.18 (GHC 8.2.2)--### 0.2.0.0--- GeoPos -> LatLong-- Split Position from GreatCircle-- require base >= 4.9--### 0.1.0.0--- Initial version+### 1.0.0.0
+
+- New API (does not allow mixing position in different coordinate systems)
+- Exact solution for both direct and inverse geodetic problems (Vincenty)
+- Conversion between different coordinate systems
+
+### 0.6.0.0
+
+- Fixed Ellipsoid: constructor expected inverseFlattening and not flattening
+
+### 0.5.0.0
+
+- Added Benchmarks
+- Added GreatArc
+- Added GreatArc from tuple of positions
+- Added GreatArc from GreatCircle
+- Added GreatArc from Track and Duration
+- Added alongTrackDistance
+- Added GreatArcs intersection
+
+### 0.4.2.0
+
+- Fixed intercept
+- jord-exe renamed jord-repl
+
+### 0.4.1.0
+
+- Fixed interceptBySpeed
+- Nautical miles symbol is "nm"
+- REPL: intercept for intercept, interceptBySpeed and interceptByTime
+- REPL: show length and speed in user selected unit
+
+### 0.4.0.0
+
+- Added ECEF, frames and delta to REPL
+- Added Speed
+- Added Duration
+- Added Kinematics: course, position, CPA and intercept
+
+### 0.3.1.0
+
+- Added ECEF position
+- Added Frames (Body, Local, North East Down)
+- Added delta and target from position(s), frame and earth model
+- Added earth models (WGS84, WGS72, GRS80 and derived spherical models)
+- Builds against LTS 12.2 (GHC 8.4.3) and LTS 11.18 (GHC 8.2.2)
+
+### 0.2.0.0
+
+- GeoPos -> LatLong
+- Split Position from GreatCircle
+- require base >= 4.9
+
+### 0.1.0.0
+
+- Initial version
LICENSE view
@@ -1,30 +1,30 @@-Copyright Cedric Liegeois (c) 2018--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Author name here nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright Cedric Liegeois (c) 2020
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -8,14 +8,16 @@ 
 ## What is this?
 
-Jord is a [Haskell](https://www.haskell.org) library that implements various geographical position calculations using the algorithms described in [Gade, K. (2010). A Non-singular Horizontal Position Representation](http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf) and in
-[Shudde, Rex H. (1986). Some tactical algorithms for spherical geometry](https://calhoun.nps.edu/bitstream/handle/10945/29516/sometacticalalgo00shud.pdf):
+Jord is a [Haskell](https://www.haskell.org) library that implements various geographical position calculations using the algorithms described in [Gade, K. (2010) - A Non-singular Horizontal Position Representation](http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf),
+[Shudde, Rex H. (1986) - Some tactical algorithms for spherical geometry](https://calhoun.nps.edu/bitstream/handle/10945/29516/sometacticalalgo00shud.pdf) and [Vincenty, T. (1975) - Direct and Inverse Solutions of Geodesics on the Ellipsoid](https://www.ngs.noaa.gov/PUBS_LIB/inverse.pdf):
 
-- transformation between ECEF (earth-centred, earth-fixed), latitude/longitude and [*n*-vector](https://www.navlab.net/nvector) positions for spherical and ellipsoidal earth model,
-- transformation between latitude/longitude and *n*-vector positions,
+- conversion between ECEF (earth-centred, earth-fixed), latitude/longitude and [*n*-vector](https://www.navlab.net/nvector) positions for spherical and ellipsoidal earth model,
+- conversion between latitude/longitude and *n*-vector positions,
 - local, body and north, east, down Frames: delta between positions, target position from reference position and delta,
-- geodetics: surface distance, initial & final bearing, interpolated position, great circle intersections, cross track distance, ...,
-- kinematics: position from p0, bearing and speed, closest point of approach between tracks, intercept (time, speed, minimum speed).
+- great circles: surface distance, initial & final bearing, interpolated position, great circle intersections, cross track distance, ...,
+- geodesic: surface distance, initial & final bearing and destination,
+- kinematics: position from p0, bearing and speed, closest point of approach between tracks, intercept (time, speed, minimum speed),
+- transformation between coordinate systems (both fixed and time-dependent).
 
 ## How do I build it?
 
@@ -29,64 +31,288 @@ 
 [See documentation on Hackage](http://hackage.haskell.org/package/jord/docs/Data-Geo-Jord.html)
 
+## Solutions to the 10 examples from [NavLab](https://www.navlab.net/nvector)
+
+### Example 1: A and B to delta
+
+*Given two positions, A and B as latitudes, longitudes and depths relative to Earth, E.*
+ 
+*Find the exact vector between the two positions, given in meters north, east, and down, and find the direction (azimuth)
+to B, relative to north. Assume WGS-84 ellipsoid. The given depths are from the ellipsoid surface. Use position A to
+define north, east, and down directions. (Due to the curvature of Earth and different directions to the North Pole,
+the north, east, and down directions will change (relative to Earth) for different places. A must be outside the poles
+for the north and east directions to be defined.)*
+
 ```haskell
-import Data.Geo.Jord
+import Data.Geo.Jord.LocalFrames
 
--- Delta between positions in frameL
-let p1 = decimalLatLongHeight 1 2 (metres (-3))
-let p2 = decimalLatLongHeight 4 5 (metres (-6))
-let w = decimalDegrees 5 -- wander azimuth
-deltaBetween p1 p2 (frameL w) wgs84 -- deltaMetres 359490.579 302818.523 17404.272
+posA = wgs84Pos 1 2 (metres 3)
+posB = wgs84Pos 4 5 (metres 6)
 
--- destination position from 531914N0014347W having travelled 500Nm on a heading of 96.0217°
--- using mean earth radius derived from the WGS84 ellipsoid
-destination84 (readLatLong "531914N0014347W") (decimalDegrees 96.0217) (nauticalMiles 500)
--- using mean earth radius derived from the GRS80 ellipsoid
-destination (readLatLong "531914N0014347W") (decimalDegrees 96.0217) (nauticalMiles 500) r80
+delta = nedBetween posA posB 
+-- > Ned (Vector3d {vx = 331730.234781, vy = 332997.874989, vz = 17404.271362})
+slantRange delta 
+-- > 470.356717903km
+bearing delta 
+-- > 45°6'33.347"
+elevation delta 
+-- > -2°7'14.011"
+```
 
--- surface distance between 54°N,154°E and its antipodal position
-let p = decimalLatLong 54 154
--- using mean earth radius derived from the WGS84 ellipsoid
-surfaceDistance84 p (antipode p)
--- using mean earth radius derived from the GRS80 ellipsoid
-surfaceDistance p (antipode p) r80
+### Example 2: A and B to delta
 
--- closest point of approach between tracks
-let p1 = decimalLatLong 20 (-60)
-let b1 = decimalDegrees 10
-let s1 = knots 15
-let p2 = decimalLatLong 34 (-50)
-let b2 = decimalDegrees 220
-let s2 = knots 300
-let t1 = Track p1 b1 s1
-let t2 = Track p2 b2 s2
--- using mean earth radius derived from the WGS84 ellipsoid
-cpa84 t1 t2
--- using mean earth radius derived from the WGS72 ellipsoid
-cpa t1 t2 r72
+*A radar or sonar attached to a vehicle B (Body coordinate frame) measures the distance and direction to an object C.
+We assume that the distance and two angles (typically bearing and elevation relative to B) are already combined to the
+vector p_BC_B (i.e. the vector from B to C, decomposed in B). The position of B is given as n_EB_E and z_EB, and the
+orientation (attitude) of B is given as R_NB (this rotation matrix can be found from roll/pitch/yaw by using zyx2R).*
+ 
+*Find the exact position of object C as n-vector and depth ( n_EC_E and z_EC ), assuming Earth ellipsoid with semi-major
+axis a and flattening f. For WGS-72, use a = 6 378 135 m and f = 1/298.26.*
+
+```haskell
+import Data.Geo.Jord.LocalFrames
+
+f = frameB (decimalDegrees 40) (decimalDegrees 20) (decimalDegrees 30)
+p = nvectorHeightPos 1 2 3 (metres 400) WGS72
+d = deltaMetres 3000 2000 100
+
+target p f d
+-- > 53°18'46.839"N,63°29'6.179"E 406.006018m (WGS72)
 ```
 
-Jord comes with a REPL (built with [haskeline](https://github.com/judah/haskeline)):
+### Example 3: ECEF-vector to geodetic latitude
 
-```sh
-$ jord-exe
-jord> finalBearing (destination (antipode 54°N,154°E) 54° 1000m) 54°N,154°E
-jord> angle: 126°0'0.0" (126.0)
-jord> f = frameB 10d 20d 30d
-jord> Body (vehicle) frame:
-      yaw  : 10°0'0.000" (10.0)
-      pitch: 20°0'0.000" (20.0)
-      roll : 30°0'0.000" (30.0)
-jord> d = delta 3000 2000 100
-jord> Delta:
-      x: 3.0km
-      y: 2.0km
-      z: 0.1km
-jord> p0 = geo 49.66618 3.45063 0
-jord> latlong: 49°39'58.248"N,3°27'2.268"E (49.66618, 3.45063)
-      height : 0.0km
-jord> target p0 f d wgs84
-jord> latlong: 49°41'30.486"N,3°28'52.561"E (49.69180166666667, 3.4812669444444446)
-      height : 6.0077e-3km
-jord>  
+*Position B is given as an “ECEF-vector” p_EB_E (i.e. a vector from E, the center of the Earth, to B, decomposed in E).
+Find the geodetic latitude, longitude and height (latEB, lonEB and hEB), assuming WGS-84 ellipsoid.*
+
+```haskell
+import Data.Geo.Jord.Position
+
+geocentricMetresPos 5733900.0 (-6371000.0) 7008100.000000001 WGS84
+-- > 39°22'43.495"N,48°0'46.035"W 4702.059834295km (WGS84)
 ```
+
+### Example 4: Geodetic latitude to ECEF-vector
+
+*Geodetic latitude, longitude and height are given for position B as latEB, lonEB and hEB, find the ECEF-vector
+for this position, p_EB_E.*
+
+```haskell
+import Data.Geo.Jord.Position
+
+gcvec (wgs84Pos 1 2 (metres 3))
+-- > Vector3d {vx = 6373290.277218281, vy = 222560.20067473655, vz = 110568.82718177968}
+```
+
+### Example 5: Surface distance
+
+*Find the surface distance sAB (i.e. great circle distance) between two positions A and B. The heights of A and B are
+ignored, i.e. if they don’t have zero height, we seek the distance between the points that are at the surface of the
+Earth, directly above/below A and B. The Euclidean distance (chord length) dAB should also be found.
+Use Earth radius 6371e3 m. Compare the results with exact calculations for the WGS-84 ellipsoid.*
+
+```haskell
+import Data.Geo.Jord.GreatCircle
+
+posA = s84Pos 88 0 zero
+posB = s84Pos 89 (-170) zero
+
+surfaceDistance posA posB
+-- > 332.456901835km
+```
+
+*Exact solution for the WGS84 ellipsoid*
+
+```haskell
+import Data.Geo.Jord.Geodesic
+
+posA = wgs84Pos 88 0 zero
+posB = wgs84Pos 89 (-170) zero
+
+surfaceDistance posA posB
+-- > Just 333.947509469km
+```
+
+### Example 6: Interpolated position
+
+*Given the position of B at time t0 and t1, n_EB_E(t0) and n_EB_E(t1).*
+ 
+*Find an interpolated position at time ti, n_EB_E(ti). All positions are given as n-vectors.*
+
+```haskell
+import Data.Geo.Jord.GreatCircle
+
+posA = s84Pos 89 0 zero
+posB = s84Pos 89 180 zero
+f = (16 - 10) / (20 - 10) :: Double
+
+interpolate posA posB f
+-- > 89°47'59.929"N,180°0'0.000"E 0.0m (S84)
+```
+
+### Example 7: Mean position
+
+*Three positions A, B, and C are given as n-vectors n_EA_E, n_EB_E, and n_EC_E. Find the mean position, M, given as
+n_EM_E. Note that the calculation is independent of the depths of the positions.*
+
+```haskell
+import Data.Geo.Jord.GreatCircle
+
+ps = [s84Pos 90 0 zero, s84Pos 60 10 zero, s84Pos 50 (-20) zero]
+
+mean ps
+-- > Just 67°14'10.150"N,6°55'3.040"W 0.0m (S84)
+```
+
+### Example 8: A and azimuth/distance to B
+
+*We have an initial position A, direction of travel given as an azimuth (bearing) relative to north (clockwise), and
+finally the distance to travel along a great circle given as sAB. Use Earth radius 6371e3 m to find the destination
+point B.*
+ 
+*In geodesy this is known as “The first geodetic problem” or “The direct geodetic problem” for a sphere, and we see
+that this is similar to Example 2, but now the delta is given as an azimuth and a great circle distance.
+(“The second/inverse geodetic problem” for a sphere is already solved in Examples 1 and 5.)*
+
+```haskell
+import Data.Geo.Jord.GreatCircle
+
+p = s84Pos 80 (-90) zero
+
+destination p (decimalDegrees 200) (metres 1000)
+-- > 79°59'29.575"N,90°1'3.714"W 0.0m (S84)
+```
+
+*Exact solution for the WGS84 ellipsoid*
+
+```haskell
+import Data.Geo.Jord.Geodesic
+
+p = wgs84Pos 80 (-90) zero
+
+destination p (decimalDegrees 200) (metres 1000)
+-- > Just 79°59'29.701"N,90°1'3.436"W 0.0m (WGS84)
+```
+
+### Example 9: Intersection of two paths
+
+*Define a path from two given positions (at the surface of a spherical Earth), as the great circle that goes through
+the two points.*
+ 
+*Path A is given by A1 and A2, while path B is given by B1 and B2.*
+ 
+*Find the position C where the two great circles intersect.*
+
+```haskell
+import Control.Monad (join)
+import Data.Geo.Jord.GreatCircle
+
+a1 = s84Pos 51.885 0.235 zero
+a2 = s84Pos 48.269 13.093 zero
+b1 = s84Pos 49.008 2.549 zero
+b2 = s84Pos 56.283 11.304 zero
+
+ga = greatCircleThrough a1 a2
+gb = greatCircleThrough b1 b2
+join (intersections <$> ga <*> gb)
+-- > Just (50°54'6.260"N,4°29'39.052"E 0.0m (S84),50°54'6.260"S,175°30'20.947"W 0.0m (S84))
+
+ma = minorArc a1 a2
+mb = minorArc b1 b2
+join (intersection <$> ma <*> mb)
+-- > Just 50°54'6.260"N,4°29'39.052"E 0.0m (S84)
+```
+
+### Example 10: Cross track distance
+
+*Path A is given by the two positions A1 and A2 (similar to the previous example).
+ 
+*Find the cross track distance sxt between the path A (i.e. the great circle through A1 and A2) and the position B
+(i.e. the shortest distance at the surface, between the great circle and B).*
+
+```haskell
+import Data.Geo.Jord.GreatCircle
+
+p = s84Pos 1 0.1 zero
+gc = greatCircleThrough (s84Pos 0 0 zero) (s84Pos 10 0 zero)
+
+fmap (\g -> crossTrackDistance p g) gc
+-- > Just 11.117814411km
+```
+
+## Solutions to kinematics problems
+
+### Closest point of approach
+
+*The Closest Point of Approach (CPA) refers to the positions at which two dynamically moving objects reach their
+closest possible distance.*
+
+```haskell
+import Data.Geo.Jord.Kinematics
+
+t1 = Track (s84Pos 20 (-60) zero) (decimalDegrees 10) (knots 15)
+t2 = Track (s84Pos 34 (-50) (metres 10000)) (decimalDegrees 220) (knots 300)
+
+cpa t1 t2
+-- > Just (Cpa {
+-- >     cpaTime = 3H9M56.155S,
+-- >     cpaDistance = 124.231730834km,
+-- >     cpaPosition1 = 20°46'43.641"N,59°51'11.225"W 0.0m (S84),
+-- >     cpaPosition2 = 21°24'8.523"N,60°50'48.159"W 10000.0m (S84)})
+```
+
+### Time required to intercept target
+
+*Inputs are the initial latitude and longitude of an interceptor and a target, and the target course and speed.
+Also input is the time of the desired intercept. Outputs are the speed required of the interceptor, the course
+of the interceptor, the distance travelled to intercept, and the latitude and longitude of the intercept.*
+
+```haskell
+import Data.Geo.Jord.Kinematics
+
+t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+ip = s84Pos 20 (-60) zero
+d = seconds 2700
+
+interceptByTime t ip d
+-- > Just (Intercept {
+-- >     interceptTime = 0H45M0.000S,
+-- >     interceptDistance = 1015.302358852km,
+-- >     interceptPosition = 28°8'12.046"N,55°27'21.411"W 0.0m (S84),
+-- >     interceptorBearing = 26°7'11.649",
+-- >     interceptorSpeed = 1353.736478km/h})
+```
+
+### Time required to intercept target
+
+*Inputs are the initial latitude and longitude of an interceptor and a target, and the target course and speed. For a
+given interceptor speed, it may or may not be possible to make an intercept.*
+
+*The first algorithm is to compute the minimum interceptor speed required to achieve intercept and the time required to
+make such and intercept.*
+
+*The second algorithm queries the user to input an interceptor speed. If the speed is at least that required for intercept
+then the time required to intercept is computed.*
+
+```haskell
+import Data.Geo.Jord.Kinematics
+
+t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+ip = s84Pos 20 (-60) zero
+
+intercept t ip
+-- > Just (Intercept {
+-- >     interceptTime = 1H39M53.831S,
+-- >     interceptDistance = 162.294627463km,
+-- >     interceptPosition = 20°43'42.305"N,61°20'56.848"W 0.0m (S84),
+-- >     interceptorBearing = 300°10'18.053",
+-- >     interceptorSpeed = 97.476999km/h})
+
+interceptBySpeed t ip (knots 700)
+-- > Just (Intercept {
+-- >     interceptTime = 0H46M4.692S,
+-- >     interceptDistance = 995.596069189km,
+-- >     interceptPosition = 27°59'36.764"N,55°34'43.852"W 0.0m (S84),
+-- >     interceptorBearing = 25°56'7.484",
+-- >     interceptorSpeed = 1296.399689km/h})
+```
− app/Eval.hs 
@@ -1,684 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
--- |
--- Module:      Eval
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Types and functions for evaluating expressions in textual form.
---
-module Eval
-    ( Result
-    , eval
-    , functions
-    ) where
-
-import Control.Monad.Fail
-import Data.Bifunctor
-import Data.Either (rights)
-import Data.Geo.Jord
-import Data.List (intercalate)
-import Data.Maybe
-import Prelude hiding (fail, lookup)
-import Show
-import State
-import Text.ParserCombinators.ReadP
-import Text.Read (readEither, readMaybe)
-
--- | 'Either' an error or a 'Value'.
-type Result = Either String Value
-
-instance MonadFail (Either String) where
-    fail = Left
-
--- | Evaluates @s@, an expression of the form @"(f x y ..)"@.
---
--- >>> eval "finalBearing (destination (antipode 54°N,154°E) 54° 1000m) 54°N,154°E"
--- 126°
---
--- @f@ must be one of the supported 'functions' and each parameter @x@, @y@, .. , is either another function call
--- or a 'String' parameter. Parameters are either resolved by name using the 'Resolve'
--- function @r@ or if it returns 'Nothing', 'read' to an 'Angle', a 'Length' or a 'LatLong'.
---
--- If the evaluation is successful, returns the resulting 'Value' ('Right') otherwise
--- a description of the error ('Left').
---
--- @
---     state = emptyState
---     angle = eval "finalBearing 54N154E 54S154W" state -- Right Ang
---     length = eval "surfaceDistance (antipode 54N154E) 54S154W" state -- Right Len
---     -- parameter resolution from state
---     a1 = eval "finalBearing 54N154E 54S154W" state
---     state = insert "a1" state
---     a2 = eval "(finalBearing a1 54S154W)" state
--- @
---
--- All returned positions are 'LatLong' by default, to get back a n-vector the
--- expression must be wrapped by 'toNVector'.
---
--- @
---     dest = eval "destination 54°N,154°E 54° 1000m" -- Right Ll
---     dest = eval "toNVector (destination 54°N,154°E 54° 1000m)" -- Right Np
--- @
---
--- Every function call must be wrapped between parentheses, however they can be ommitted for the top level call.
---
--- @
---     angle = eval "finalBearing 54N154E 54S154W" -- Right Ang
---     angle = eval "(finalBearing 54N154E 54S154W)" -- Right Ang
---     length = eval "distance (antipode 54N154E) 54S154W" -- Right Len
---     length = eval "distance antipode 54N154E 54S154W" -- Left String
--- @
---
-eval :: String -> State -> Result
-eval st state =
-    case expr st of
-        Left err -> Left err
-        Right (rvec, expr') -> convert (evalExpr expr' state) rvec
-
-convert :: Result -> Bool -> Result
-convert r True = r
-convert r False =
-    case r of
-        Right v@(Np _) -> Right (toGeo v)
-        Right (Vals vs) -> Right (Vals (map toGeo vs))
-        oth -> oth
-
-toGeo :: Value -> Value
-toGeo (Np v) = Gp (fromNVector v)
-toGeo val = val
-
--- | All supported functions.
-functions :: [String]
-functions =
-    [ "alongTrackDistance"
-    , "antipode"
-    , "crossTrackDistance"
-    , "cpa"
-    , "delta"
-    , "deltaBetween"
-    , "destination"
-    , "ecef"
-    , "frameB"
-    , "frameL"
-    , "frameN"
-    , "finalBearing"
-    , "fromEcef"
-    , "geo"
-    , "greatArc"
-    , "greatCircle"
-    , "initialBearing"
-    , "intercept"
-    , "interpolate"
-    , "intersection"
-    , "intersections"
-    , "isInsideSurface"
-    , "mean"
-    , "ned"
-    , "nedBetween"
-    , "position"
-    , "surfaceDistance"
-    , "target"
-    , "targetN"
-    , "track"
-    , "toEcef"
-    , "toNVector"
-    ]
-
-expr :: (MonadFail m) => String -> m (Bool, Expr)
-expr s = do
-    ts <- tokenise s
-    ast <- parse ts
-    fmap (expectVec ts, ) (transform ast)
-
-expectVec :: [Token] -> Bool
-expectVec (_:Func "toNVector":_) = True
-expectVec _ = False
-
-evalExpr :: Expr -> State -> Result
-evalExpr (Param p) state =
-    case lookup p state of
-        Just (Gp geo) -> Right (Np (toNVector geo))
-        Just v -> Right v
-        Nothing -> tryRead p
-evalExpr (AlongTrackDistance a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p), Right (Ga ga)] -> Right (Len (alongTrackDistance84 p ga))
-        r -> Left ("Call error: alongTrackDistance84 " ++ showErr r state)
-evalExpr (Antipode a) state =
-    case evalExpr a state of
-        (Right (Np p)) -> Right (Np (antipode p))
-        r -> Left ("Call error: antipode " ++ showErr [r] state)
-evalExpr (ClosestPointOfApproach a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Trk t1), Right (Trk t2)] ->
-            maybe (Left "closest point of approach in the past") (Right . Cpa) (cpa84 t1 t2)
-        r -> Left ("Call error: cpa " ++ showErr r state)
-evalExpr (CrossTrackDistance a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p), Right (Gc gc)] -> Right (Len (crossTrackDistance84 p gc))
-        r -> Left ("Call error: crossTrackDistance " ++ showErr r state)
-evalExpr (DeltaBetween a b c d) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state, evalEarth d] of
-        [Right (Np p1), Right (Np p2), Right (FrmB y p r), Right (Em m)] ->
-            Right (Dlt (deltaBetween p1 p2 (frameB y p r) m))
-        [Right (Np p1), Right (Np p2), Right (FrmL w), Right (Em m)] ->
-            Right (Dlt (deltaBetween p1 p2 (frameL w) m))
-        [Right (Np p1), Right (Np p2), Right FrmN, Right (Em m)] ->
-            Right (Dlt (deltaBetween p1 p2 frameN m))
-        r -> Left ("Call error: deltaBetween " ++ showErr r state)
-evalExpr (DeltaV a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Len x), Right (Len y), Right (Len z)] -> Right (Dlt (delta x y z))
-        [Right (Double x), Right (Double y), Right (Double z)] -> Right (Dlt (deltaMetres x y z))
-        r -> Left ("Call error: delta " ++ showErr r state)
-evalExpr (Destination a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Np p), Right (Ang a'), Right (Len l)] -> Right (Np (destination84 p a' l))
-        [Right (Np p), Right (Double a'), Right (Len l)] ->
-            Right (Np (destination84 p (decimalDegrees a') l))
-        r -> Left ("Call error: destination " ++ showErr r state)
-evalExpr (Ecef a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Len x), Right (Len y), Right (Len z)] -> Right (Ep (ecef x y z))
-        [Right (Double x), Right (Double y), Right (Double z)] -> Right (Ep (ecefMetres x y z))
-        r -> Left ("Call error: ecef " ++ showErr r state)
-evalExpr (FrameB a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Ang a'), Right (Ang b'), Right (Ang c')] -> Right (FrmB a' b' c')
-        r -> Left ("Call error: frameB " ++ showErr r state)
-evalExpr (FrameL a) state =
-    case evalExpr a state of
-        (Right (Ang a')) -> Right (FrmL a')
-        r -> Left ("Call error: frameL " ++ showErr [r] state)
-evalExpr FrameN _ = Right FrmN
-evalExpr (FromEcef a b) state =
-    case [evalExpr a state, evalEarth b] of
-        [Right (Ep p), Right (Em m)] -> Right (Np (fromEcef p m))
-        r -> Left ("Call error: fromEcef " ++ showErr r state)
-evalExpr (FinalBearing a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p1), Right (Np p2)] ->
-            maybe
-                (Left "Call error: finalBearing identical points")
-                (Right . Ang)
-                (finalBearing p1 p2)
-        r -> Left ("Call error: finalBearing " ++ showErr r state)
-evalExpr (Geo as) state =
-    case vs of
-        [Right p@(Np _)] -> Right p
-        [Right (Np v), Right (Len h)] -> Right (Np (AngularPosition (pos v) h))
-        [Right (Double lat), Right (Double lon)] ->
-            bimap
-                (\e -> "Call error: geo " ++ e)
-                (Np . toNVector)
-                (decimalLatLongHeightE lat lon zero)
-        [Right (Double lat), Right (Double lon), Right (Len h)] ->
-            bimap (\e -> "Call error: geo " ++ e) (Np . toNVector) (decimalLatLongHeightE lat lon h)
-        [Right (Double lat), Right (Double lon), Right (Double h)] ->
-            bimap
-                (\e -> "Call error: geo " ++ e)
-                (Np . toNVector)
-                (decimalLatLongHeightE lat lon (metres h))
-        r -> Left ("Call error: geo " ++ showErr r state)
-  where
-    vs = map (`evalExpr` state) as
-evalExpr (GreatArcE as) state =
-    case fmap (`evalExpr` state) as of
-        [Right (Np p1), Right (Np p2)] -> bimap id Ga (greatArcE (p1, p2))
-        [Right (Trk t), Right (Dur d)] -> bimap id Ga (greatArcE (t, d))
-        r -> Left ("Call error: greatArc " ++ showErr r state)
-evalExpr (GreatCircleE as) state =
-    case fmap (`evalExpr` state) as of
-        [Right (Np p1), Right (Np p2)] -> bimap id Gc (greatCircleE (p1, p2))
-        [Right (Np p), Right (Ang a')] -> bimap id Gc (greatCircleE (p, a'))
-        [Right (Ga ga)] -> bimap id Gc (greatCircleE ga)
-        [Right (Trk t)] -> bimap id Gc (greatCircleE t)
-        r -> Left ("Call error: greatCircle " ++ showErr r state)
-evalExpr (InitialBearing a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p1), Right (Np p2)] ->
-            maybe
-                (Left "Call error: initialBearing identical points")
-                (Right . Ang)
-                (initialBearing p1 p2)
-        r -> Left ("Call error: initialBearing " ++ showErr r state)
-evalExpr (Intercept as) state =
-    case fmap (`evalExpr` state) as of
-        [Right (Trk t), Right (Np i)] ->
-            maybe (Left "undefined minimum speed intercept") (Right . Intp) (intercept84 t i)
-        [Right (Trk t), Right (Np i), Right (Spd s)] ->
-            maybe (Left "undefined time to intercept") (Right . Intp) (interceptBySpeed84 t i s)
-        [Right (Trk t), Right (Np i), Right (Dur d)] ->
-            maybe (Left "undefined speed to intercept") (Right . Intp) (interceptByTime84 t i d)
-        r -> Left ("Call error: intercept " ++ showErr r state)
-evalExpr (Interpolate a b c) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p1), Right (Np p2)] -> Right (Np (interpolate p1 p2 c))
-        r -> Left ("Call error: interpolate " ++ showErr r state)
-evalExpr (Intersection a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Ga ga1), Right (Ga ga2)] ->
-            maybe
-                (Left "no great arcs intersection")
-                (Right . Np)
-                (intersection ga1 ga2 :: Maybe (AngularPosition NVector))
-        r -> Left ("Call error: intersection " ++ showErr r state)
-evalExpr (Intersections a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Gc gc1), Right (Gc gc2)] ->
-            maybe
-                (Right (Vals []))
-                (\is -> Right (Vals [Np (fst is), Np (snd is)]))
-                (intersections gc1 gc2 :: Maybe (AngularPosition NVector, AngularPosition NVector))
-        r -> Left ("Call error: intersections " ++ showErr r state)
-evalExpr (IsInsideSurface as) state =
-    let m = map (`evalExpr` state) as
-        ps = [p | Right (Np p) <- m]
-     in if length m == length ps && length ps > 3
-            then Right (Bool (isInsideSurface (head ps) (tail ps)))
-            else Left ("Call error: isInsideSurface " ++ showErr m state)
-evalExpr (Mean as) state =
-    let m = map (`evalExpr` state) as
-        ps = [p | Right (Np p) <- m]
-     in if length m == length ps
-            then maybe (Left ("Call error: mean " ++ showErr m state)) (Right . Np) (mean ps)
-            else Left ("Call error: mean " ++ showErr m state)
-evalExpr (NedBetween a b c) state =
-    case [evalExpr a state, evalExpr b state, evalEarth c] of
-        [Right (Np p1), Right (Np p2), Right (Em m)] -> Right (Ned (nedBetween p1 p2 m))
-        r -> Left ("Call error: nedBetween " ++ showErr r state)
-evalExpr (NedV a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Len x), Right (Len y), Right (Len z)] -> Right (Ned (ned x y z))
-        [Right (Double x), Right (Double y), Right (Double z)] -> Right (Ned (nedMetres x y z))
-        r -> Left ("Call error: ned " ++ showErr r state)
-evalExpr (Position a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Trk t), Right (Dur d)] -> Right (Np (position84 t d))
-        r -> Left ("Call error: position " ++ showErr r state)
-evalExpr (SurfaceDistance a b) state =
-    case [evalExpr a state, evalExpr b state] of
-        [Right (Np p1), Right (Np p2)] -> Right (Len (surfaceDistance84 p1 p2))
-        r -> Left ("Call error: surfaceDistance " ++ showErr r state)
-evalExpr (Target a b c d) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state, evalEarth d] of
-        [Right (Np p0), Right (FrmB y p r), Right (Dlt d'), Right (Em m)] ->
-            Right (Np (target p0 (frameB y p r) d' m))
-        [Right (Np p0), Right (FrmL w), Right (Dlt d'), Right (Em m)] ->
-            Right (Np (target p0 (frameL w) d' m))
-        [Right (Np p0), Right FrmN, Right (Dlt d'), Right (Em m)] ->
-            Right (Np (target p0 frameN d' m))
-        r -> Left ("Call error: target " ++ showErr r state)
-evalExpr (TargetN a b c) state =
-    case [evalExpr a state, evalExpr b state, evalEarth c] of
-        [Right (Np p0), Right (Ned d), Right (Em m)] -> Right (Np (targetN p0 d m))
-        r -> Left ("Call error: targetN " ++ showErr r state)
-evalExpr (TrackE a b c) state =
-    case [evalExpr a state, evalExpr b state, evalExpr c state] of
-        [Right (Np p), Right (Ang b'), Right (Spd s)] -> Right (Trk (Track p b' s))
-        r -> Left ("Call error: track " ++ showErr r state)
-evalExpr (ToEcef a b) state =
-    case [evalExpr a state, evalEarth b] of
-        [Right (Np p), Right (Em m)] -> Right (Ep (toEcef p m))
-        r -> Left ("Call error: toEcef " ++ showErr r state)
-evalExpr (ToNVector a) state =
-    case evalExpr a state of
-        r@(Right (Np _)) -> r
-        r -> Left ("Call error: toNVector " ++ showErr [r] state)
-
-evalEarth :: String -> Result
-evalEarth "wgs84" = Right (Em wgs84)
-evalEarth "grs80" = Right (Em grs80)
-evalEarth "wgs72" = Right (Em wgs72)
-evalEarth "s84" = Right (Em s84)
-evalEarth "s80" = Right (Em s80)
-evalEarth "s72" = Right (Em s72)
-evalEarth s = Left s
-
-showErr :: [Result] -> State -> String
-showErr rs s = " > " ++ intercalate " & " (map (either id (`showV` s)) rs)
-
-tryRead :: String -> Result
-tryRead s
-    | null r = Left ("couldn't read " ++ s)
-    | otherwise = Right (head r)
-  where
-    r =
-        rights
-            (map ($ s)
-                 [ readE readAngleE Ang
-                 , readE readLengthE Len
-                 , readE readSpeedE Spd
-                 , readE readDurationE Dur
-                 , readE readLatLongE (\ll -> Np (toNVector (AngularPosition ll zero)))
-                 , readE readEither Double
-                 ])
-
-readE :: (String -> Either String a) -> (a -> Value) -> String -> Either String Value
-readE p v s = bimap id v (p s)
-
-------------------------------------------
---  Lexical Analysis: String -> [Token] --
-------------------------------------------
-data Token
-    = Paren Char
-    | Func String
-    | Str String
-    deriving (Show)
-
-tokenise :: (MonadFail m) => String -> m [Token]
-tokenise s
-    | null r = fail ("Lexical error: " ++ s)
-    | (e, "") <- last r = return (wrap e)
-    | otherwise = fail ("Lexical error: " ++ snd (last r))
-  where
-    r = readP_to_S tokens s
-
--- | wraps top level expression between () if needed.
-wrap :: [Token] -> [Token]
-wrap ts
-    | null ts = ts
-    | (Paren '(') <- head ts = ts
-    | otherwise = Paren '(' : ts ++ [Paren ')']
-
-tokens :: ReadP [Token]
-tokens = many1 token
-
-token :: ReadP Token
-token = (<++) ((<++) paren func) str
-
-paren :: ReadP Token
-paren = (<++) parenO parenC
-
-parenO :: ReadP Token
-parenO = do
-    optional (char ' ')
-    c <- char '('
-    return (Paren c)
-
-parenC :: ReadP Token
-parenC = do
-    c <- char ')'
-    optional (char ' ')
-    return (Paren c)
-
-func :: ReadP Token
-func = do
-    n <- choice (map string functions)
-    _ <- char ' '
-    return (Func n)
-
-str :: ReadP Token
-str = do
-    optional (char ' ')
-    v <- munch1 (\c -> c /= '(' && c /= ')' && c /= ' ')
-    if v `elem` functions
-        then pfail
-        else return (Str v)
-
------------------------------------------
---  Syntactic Analysis: [Token] -> Ast --
------------------------------------------
-data Ast
-    = Call String
-           [Ast]
-    | Lit String
-    deriving (Show)
-
--- | syntax is (f x y) where x and y can be function themselves.
-parse :: (MonadFail m) => [Token] -> m Ast
-parse ts = fmap fst (walk ts)
-
-walk :: (MonadFail m) => [Token] -> m (Ast, [Token])
-walk [] = fail "Syntax error: empty"
-walk (h:t)
-    | (Str s) <- h = return (Lit s, t)
-    | (Paren '(') <- h = walkFunc t
-    | otherwise = fail ("Syntax error: expected String or '(' but got " ++ show h)
-
-walkFunc :: (MonadFail m) => [Token] -> m (Ast, [Token])
-walkFunc [] = fail "Syntax error: '(' unexpected"
-walkFunc (h:t)
-    | (Func n) <- h = walkParams n t []
-    | otherwise = fail ("Syntax error: expected Function but got " ++ show h)
-
-walkParams :: (MonadFail m) => String -> [Token] -> [Ast] -> m (Ast, [Token])
-walkParams _ [] _ = fail "Syntax error: ')' not found"
-walkParams n ts@(h:t) acc
-    | (Paren ')') <- h = return (Call n (reverse acc), t)
-    | otherwise = do
-        (el, t') <- walk ts
-        walkParams n t' (el : acc)
-
--------------------------------------
---  Semantic Analysis: Ast -> Expr --
--------------------------------------
-data Expr
-    = Param String
-    | AlongTrackDistance Expr
-                         Expr
-    | Antipode Expr
-    | ClosestPointOfApproach Expr
-                             Expr
-    | CrossTrackDistance Expr
-                         Expr
-    | DeltaBetween Expr
-                   Expr
-                   Expr
-                   String
-    | DeltaV Expr
-             Expr
-             Expr
-    | Destination Expr
-                  Expr
-                  Expr
-    | Ecef Expr
-           Expr
-           Expr
-    | FrameB Expr
-             Expr
-             Expr
-    | FrameL Expr
-    | FrameN
-    | FinalBearing Expr
-                   Expr
-    | FromEcef Expr
-               String
-    | Geo [Expr]
-    | GreatArcE [Expr]
-    | GreatCircleE [Expr]
-    | InitialBearing Expr
-                     Expr
-    | Intercept [Expr]
-    | Interpolate Expr
-                  Expr
-                  Double
-    | Intersection Expr
-                   Expr
-    | Intersections Expr
-                    Expr
-    | IsInsideSurface [Expr]
-    | Mean [Expr]
-    | NedBetween Expr
-                 Expr
-                 String
-    | NedV Expr
-           Expr
-           Expr
-    | Position Expr
-               Expr
-    | SurfaceDistance Expr
-                      Expr
-    | Target Expr
-             Expr
-             Expr
-             String
-    | TargetN Expr
-              Expr
-              String
-    | TrackE Expr
-             Expr
-             Expr
-    | ToEcef Expr
-             String
-    | ToNVector Expr
-    deriving (Show)
-
-transform :: (MonadFail m) => Ast -> m Expr
-transform (Call "alongTrackDistance" [e1, e2]) = do
-    p <- transform e1
-    ga <- transform e2
-    return (AlongTrackDistance p ga)
-transform (Call "antipode" [e]) = fmap Antipode (transform e)
-transform (Call "cpa" [e1, e2]) = do
-    t1 <- transform e1
-    t2 <- transform e2
-    return (ClosestPointOfApproach t1 t2)
-transform (Call "crossTrackDistance" [e1, e2]) = do
-    p <- transform e1
-    gc <- transform e2
-    return (CrossTrackDistance p gc)
-transform (Call "delta" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    p3 <- transform e3
-    return (DeltaV p1 p2 p3)
-transform (Call "deltaBetween" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    f <- transform e3
-    return (DeltaBetween p1 p2 f "wgs84")
-transform (Call "deltaBetween" [e1, e2, e3, Lit s]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    f <- transform e3
-    return (DeltaBetween p1 p2 f s)
-transform (Call "destination" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    p3 <- transform e3
-    return (Destination p1 p2 p3)
-transform (Call "ecef" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    p3 <- transform e3
-    return (Ecef p1 p2 p3)
-transform (Call "frameB" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    p3 <- transform e3
-    return (FrameB p1 p2 p3)
-transform (Call "frameL" [e]) = fmap FrameL (transform e)
-transform (Call "frameN" []) = return FrameN
-transform (Call "fromEcef" [e]) = do
-    p <- transform e
-    return (FromEcef p "wgs84")
-transform (Call "fromEcef" [e, Lit s]) = do
-    p <- transform e
-    return (FromEcef p s)
-transform (Call "finalBearing" [e1, e2]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    return (FinalBearing p1 p2)
-transform (Call "geo" e) = do
-    ps <- mapM transform e
-    return (Geo ps)
-transform (Call "greatArc" e) = do
-    ps <- mapM transform e
-    return (GreatArcE ps)
-transform (Call "greatCircle" e) = do
-    ps <- mapM transform e
-    return (GreatCircleE ps)
-transform (Call "initialBearing" [e1, e2]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    return (InitialBearing p1 p2)
-transform (Call "intercept" e) = do
-    ps <- mapM transform e
-    return (Intercept ps)
-transform (Call "interpolate" [e1, e2, Lit s]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    d <- readDouble s
-    if d >= 0.0 && d <= 1.0
-        then return (Interpolate p1 p2 d)
-        else fail "Semantic error: interpolate expects [0..1] as last argument"
-transform (Call "intersection" [e1, e2]) = do
-    ga1 <- transform e1
-    ga2 <- transform e2
-    return (Intersection ga1 ga2)
-transform (Call "intersections" [e1, e2]) = do
-    gc1 <- transform e1
-    gc2 <- transform e2
-    return (Intersections gc1 gc2)
-transform (Call "isInsideSurface" e) = do
-    ps <- mapM transform e
-    return (IsInsideSurface ps)
-transform (Call "mean" e) = do
-    ps <- mapM transform e
-    return (Mean ps)
-transform (Call "ned" [e1, e2, e3]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    p3 <- transform e3
-    return (NedV p1 p2 p3)
-transform (Call "nedBetween" [e1, e2]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    return (NedBetween p1 p2 "wgs84")
-transform (Call "nedBetween" [e1, e2, Lit s]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    return (NedBetween p1 p2 s)
-transform (Call "position" [e1, e2]) = do
-    t <- transform e1
-    d <- transform e2
-    return (Position t d)
-transform (Call "surfaceDistance" [e1, e2]) = do
-    p1 <- transform e1
-    p2 <- transform e2
-    return (SurfaceDistance p1 p2)
-transform (Call "target" [e1, e2, e3]) = do
-    p0 <- transform e1
-    f <- transform e2
-    d <- transform e3
-    return (Target p0 f d "wgs84")
-transform (Call "target" [e1, e2, e3, Lit s]) = do
-    p0 <- transform e1
-    f <- transform e2
-    d <- transform e3
-    return (Target p0 f d s)
-transform (Call "targetN" [e1, e2]) = do
-    p0 <- transform e1
-    d <- transform e2
-    return (TargetN p0 d "wgs84")
-transform (Call "targetN" [e1, e2, Lit s]) = do
-    p0 <- transform e1
-    d <- transform e2
-    return (TargetN p0 d s)
-transform (Call "track" [e1, e2, e3]) = do
-    p0 <- transform e1
-    b <- transform e2
-    s <- transform e3
-    return (TrackE p0 b s)
-transform (Call "toEcef" [e]) = do
-    p <- transform e
-    return (ToEcef p "wgs84")
-transform (Call "toEcef" [e, Lit s]) = do
-    p <- transform e
-    return (ToEcef p s)
-transform (Call "toNVector" [e]) = fmap ToNVector (transform e)
-transform (Call f e) = fail ("Semantic error: " ++ f ++ " does not accept " ++ show e)
-transform (Lit s) = return (Param s)
-
-readDouble :: (MonadFail m) => String -> m Double
-readDouble s =
-    case readMaybe s of
-        Just d -> return d
-        Nothing -> fail ("Unparsable double: " ++ s)
− app/Main.hs 
@@ -1,218 +0,0 @@--- |
--- Module:      Main
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- REPL around "Jord".
---
-module Main where--import Data.Geo.Jord-import Data.List ((\\), dropWhileEnd, isPrefixOf)-import Eval-import Prelude hiding (lookup)-import Show-import State-import System.Console.Haskeline--search :: String -> [Completion]-search s = map simpleCompletion $ filterFunc s--filterFunc :: String -> [String]-filterFunc s = map (\f -> pref ++ f) filtered-  where-    pref = dropWhileEnd (/= '(') s -- everything before the last '(' inclusive
-    func = (\\) s pref -- everything after the last '('
-    filtered = filter (\f -> func `isPrefixOf` f) functions--mySettings :: Settings IO-mySettings =-    Settings-        { complete = completeWord Nothing " \t" $ return . search-        , historyFile = Nothing-        , autoAddHistory = True-        }--main :: IO ()-main = do-    putStrLn-        ("jord interpreter, version " ++-         jordVersion ++ ": https://github.com/ofmooseandmen/jord  :? for help")-    runInputT mySettings $ withInterrupt $ loop emptyState-  where-    loop state = do-        input <- handleInterrupt (return (Just "")) $ getInputLine "jord> "-        case input of-            Nothing -> return ()-            Just ":quit" -> return ()-            Just ":q" -> return ()-            Just i -> do-                let (result, newState) = evalS i state-                printS result-                loop newState--printS :: Either String String -> InputT IO ()-printS (Left err) = outputStrLn ("jord> " ++ err)-printS (Right "") = return ()-printS (Right r) = outputStrLn ("jord> " ++ r)--evalS :: String -> State -> (Either String String, State)-evalS s state-    | null s = (Right "", state)-    | head s == ':' = evalC w state-    | (v:"=":e) <- w =-        if v `elem` functions-            then (Left (v ++ " is a reserved keyword"), state)-            else let r = eval (unwords e) state-                     state' = save r v state-                  in (showR r state', state')-    | otherwise = (showR (eval s state) state, state)-  where-    w = words s--evalC :: [String] -> State -> (Either String String, State)-evalC [":help"] state = (Right (help state), state)-evalC [":?"] state = (Right (help state), state)-evalC [":show", v] state = (evalShow v state, state)-evalC [":delete", v] state = (Right ("deleted var: " ++ v), delete v state)-evalC [":units", u1, u2] state = evalUnits [u1, u2] state-evalC [":units", u] state = evalUnits [u] state-evalC [":units"] state = showUnits state-evalC [":reset"] _ = (Right "REPL reset ", emptyState)-evalC c state = (Left ("Unsupported command " ++ unwords c ++ "; :? for help"), state)--evalShow :: String -> State -> Either String String-evalShow n state =-    maybe (Left ("Unbound variable: " ++ n)) (\v -> Right (showVar n v state)) (lookup n state)--evalUnits :: [String] -> State -> (Either String String, State)-evalUnits us s = showUnits (setUnits us s)--showUnits :: State -> (Either String String, State)-showUnits s = (Right ("Units:\n  length = " ++ lengthUnit s ++ "\n  speed  = " ++ speedUnit s), s)--help :: State -> String-help s =-    "\njord interpreter, version " ++-    jordVersion ++-    "\n" ++-    "\n Commands available from the prompt:\n\n" ++-    "    :help, :?              display this list of commands\n" ++-    "    :quit, :q              quit jord\n" ++-    "    :show {var}            show {var}\n" ++-    "    :delete {var}          delete {var}\n" ++-    "    :units length speed    set length and speed units used for display\n" ++-    "                           see supported length and speed format\n" ++-    "                           currently: length = " ++-    lengthUnit s ++-    "; speed = " ++-    speedUnit s ++-    "\n" ++-    "    :units                 show length and speed units used for display\n" ++-    "    :reset                 reset REPL to default state (including deleting all variables)\n" ++-    "\n Jord expressions:\n\n" ++-    "    (f x y) where f is one of function described below and x and y\n" ++-    "    are either parameters in one of the format described below or\n" ++-    "    a call to another function\n" ++-    "\n" ++-    "    (finalBearing (destination (antipode 54°N,154°E) 54° 1000m) 54°N,154°E)\n" ++-    "\n" ++-    "    Top level () can be ommitted: antipode 54N028E\n" ++-    "\n  Position calculations (Frames):\n\n" ++-    "     The following calculations work with both ellipsoidal and derived earth model\n" ++-    "     WGS84 ellipsoid is used if model is omitted\n" ++-    "\n     deltaBetween pos1 pos2 frame (earth)  delta between pos1 and pos2 in frame originating at pos1\n" ++-    "     nedBetween pos1 pos2 (earth)          NED between pos1 and pos2 in frame N originating at pos1\n" ++-    "     target pos frame delta (earth)        target position from pos and delta in frame originating at pos\n" ++-    "     targetN pos delta (earth)             target position from pos and NED in frame N originating at pos\n" ++-    "\n  Position calculations (Spherical Earth):\n\n" ++-    "     The following calculations assume a spherical earth model with a radius\n" ++-    "     derived from the WGS84 ellipsoid: " ++-    showLength r84 s ++-    "\n" ++-    "\n     alongTrackDistance pos ga           signed distance of pos to perpendicular of great arc ga\n" ++-    "     antipode pos                          antipodal point of pos\n" ++-    "     crossTrackDistance pos gc             signed distance from pos to great circle gc\n" ++-    "     destination pos ang len               destination position from pos having travelled len\n" ++-    "                                           on initial bearing ang (either in text form or decimal degrees)\n" ++-    "     finalBearing pos1 pos2                initial bearing from pos1 to pos2\n" ++-    "     initialBearing pos1 pos2              bearing arriving at pos2 from pos1\n" ++-    "     interpolate pos1 pos2 (0..1)          position at fraction between pos1 and pos2\n" ++-    "     intersections gc1 gc2                 intersections between great circles gc1 and gc2\n" ++-    "                                           exactly 0 or 2 intersections\n" ++-    "     insideSurface pos [pos]               is p inside surface polygon?\n" ++-    "     mean [pos]                            geographical mean surface position of [pos]\n" ++-    "     surfaceDistance pos1 pos2             surface distance between pos1 and pos2\n" ++-    "\n  Kinematics calculations (Spherical Earth):\n\n" ++-    "     The following calculations assume a spherical earth model with a radius\n" ++-    "     derived from the WGS84 ellipsoid: " ++-    showLength r84 s ++-    "\n" ++-    "\n     position track dur                    position of track after duration\n" ++-    "     cpa track1 track2                     closest point of approach between two tracks\n" ++-    "     intercept track pos                   minimum speed of interceptor at pos to intercept target\n" ++-    "     intercept track pos spd               time needed by interceptor at pos and travelling at spd to intercept target\n" ++-    "     intercept track pos dur               speed needed by interceptor at pos to intercept target after duration\n" ++-    "\n  Constructors and conversions:\n\n" ++-    "     ecef len len len                      earth-centred earth-fixed position from x, y, z lengths\n" ++-    "     ecef metres metres metres             earth-centred earth-fixed position from x, y, z metres\n" ++-    "     toEcef pos (earth)                    geographic position to ECEF position using earth model\n" ++-    "                                           WGS84 ellipsoid is used if model is omitted\n" ++-    "     fromEcef ecef (earth)                 ECEF position to geographic position using earth model\n" ++-    "                                           WGS84 ellipsoid is used if model is omitted\n" ++-    "     frameB ang ang ang                    body frame (vehicle) from yaw, pitch and roll angles\n" ++-    "     frameL ang                            local frame from wander azimuth angle\n" ++-    "     frameN                                north, east, down frame\n" ++-    "     delta len len len                     delta from lengths\n" ++-    "     delta metres metres metres            delta from metres\n" ++-    "     ned len len len                       north, east, down from lengths\n" ++-    "     ned metres metres metres              north, east, down from metres\n" ++-    "     geo latlong                           surface geographic position from latlong\n" ++-    "     geo latlong height                    geographic position from latlong and height\n" ++-    "     geo lat long height                   geographic position from decimal latitude, longitude and height\n" ++-    "     geo lat long metres                   geographic position from decimal latitude, longitude and metres\n" ++-    "     toNVector pos                         n-vector corresponding to pos\n" ++-    "     greatArc pos1 pos2                    great arc passing by pos1 and pos2\n" ++-    "     greatArc track dur                    great arc from track and duration\n" ++-    "     greatCircle pos1 pos2                 great circle passing by pos1 and pos2\n" ++-    "     greatCircle pos1 pos2                 great circle passing by pos1 and pos2\n" ++-    "     greatCircle pos ang                   great circle passing by pos and heading on bearing ang\n" ++-    "     greatCircle ga                        great circle from great arc\n" ++-    "     greatCircle track                     great circle from track\n" ++-    "     track pos ang spd                     track at pos, heading on bearing ang and travelling at speed spd\n" ++-    "\n  Supported lat/long formats:\n\n" ++-    "    DD(MM)(SS)[N|S]DDD(MM)(SS)[E|W] - 553621N0130209E\n" ++-    "    d°m's\"[N|S],d°m's\"[E|W]         - 55°36'21\"N,13°2'9\"E\n" ++-    "    ^ zeroes can be ommitted and separtors can also be d, m, s\n" ++-    "    decimal°[N|S],decimal°[E|W]     - 51.885°N,13,1°E\n" ++-    "\n  Supported angle formats:\n\n" ++-    "    d°m's    - 55°36'21.154\n" ++-    "    decimal° - 51.885°\n" ++-    "\n  Supported length formats: {l}m, {l}km, {l}nm, {l}ft\n" ++-    "\n  Supported speed formats: {s}m/s, {s}km/h, {s}mph, {s}kt, {s}ft/s\n" ++-    "\n  Supported duration formats: (-)nHnMn.nS\n" ++-    "\n  Supported earth models:\n\n" ++-    "    ellipsoidal: wgs84, grs80, wgs72\n" ++-    "    spherical  : s84, s80, s72\n" ++-    "\n\n  Every evaluated result can be saved by prefixing the expression with \"{var} = \"\n" ++-    "  Saved results can subsequently be used when calling a function\n" ++-    "\n  Examples:\n\n" ++-    "    jord> a = antipode 54N028E\n" ++-    "    jord> antipode a\n" ++-    "    jord> f = frameB 10d 20d 30d\n" ++-    "    jord> d = delta 3000 2000 100\n" ++-    "    jord> p0 = geo 49.66618 3.45063 0\n" ++ "    jord> target p0 f d wgs84\n"--save :: Result -> String -> State -> State-save (Right v) k state = insert k v state-save _ _ state = state--showR :: Result -> State -> Either String String-showR (Left err) _ = Left err-showR (Right v) s = Right (showV v s)--showVar :: String -> Value -> State -> String-showVar n v s = n ++ "=" ++ showV v s
− app/Show.hs 
@@ -1,107 +0,0 @@--- |
--- Module:      Show
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Show 'Value's.
---
-module Show-    ( showV-    ) where--import Data.Geo.Jord-import Data.List (intercalate)-import State---- | show value.
-showV :: Value -> State -> String-showV (Ang a) _ = "angle: " ++ showAng a-showV (Bool b) _ = show b-showV (Cpa c) s =-    "closest point of approach:" ++-    "\n      time    : " ++-    show (cpaTime c) ++-    "\n      distance: " ++-    showLength (cpaDistance c) s ++-    "\n      pos1    : " ++-    showLl (fromNVector . cpaPosition1 $ c :: LatLong) ++-    "\n      pos2    : " ++ showLl (fromNVector . cpaPosition2 $ c :: LatLong)-showV (Dlt d) s =-    "Delta:" ++-    "\n      x: " ++-    showLength (dx d) s ++-    "\n      y: " ++ showLength (dy d) s ++ "\n      z: " ++ showLength (dz d) s-showV (Dur d) _ = "duration: " ++ show d-showV (Double d) _ = show d-showV (Em m) _ = "Earth model: " ++ show m-showV (Ep p) s =-    "ECEF:" ++-    "\n      x: " ++-    showLength (ex p) s ++-    "\n      y: " ++ showLength (ey p) s ++ "\n      z: " ++ showLength (ez p) s-showV (FrmB y p r) _ =-    "Body (vehicle) frame:" ++-    "\n      yaw  : " ++-    showAng y ++ "\n      pitch: " ++ showAng p ++ "\n      roll : " ++ showAng r-showV (FrmL w) _ = "Local frame:" ++ "\n      wander azimuth: " ++ showAng w-showV FrmN _ = "North, East, Down frame"-showV (Ga ga) _ =-    "great arc: passing by " ++-    (showLl . nvectorToLatLong . gaStart $ ga) ++-    " and " ++ (showLl . nvectorToLatLong . gaEnd $ ga)-showV (Gc gc) _ =-    "great circle: passing by " ++-    (showLl . nvectorToLatLong . gcPos $ gc) ++ " heading on " ++ (showAng . gcBearing $ gc)-showV (Gp g) s = "latlong: " ++ showLl ll ++ "\n      height : " ++ showLength h s-  where-    ll = pos g-    h = height g-showV (Intp i) s =-    "intercept:" ++-    "\n      time               : " ++-    show (interceptTime i) ++-    "\n      distance           : " ++-    showLength (interceptDistance i) s ++-    "\n      pos                : " ++-    showLl (fromNVector . interceptPosition $ i :: LatLong) ++-    "\n      interceptor speed  : " ++-    showSpeed (interceptorSpeed i) s ++-    "\n      interceptor bearing: " ++ showAng (interceptorBearing i)-showV (Len l) s = "length: " ++ showLength l s-showV (Ned d) s =-    "NED:" ++-    "\n      north: " ++-    showLength (north d) s ++-    "\n      east : " ++ showLength (east d) s ++ "\n      down : " ++ showLength (down d) s-showV (Np nv) s =-    "n-vector: " ++-    show x ++ ", " ++ show y ++ ", " ++ show z ++ "\n      height  : " ++ showLength h s-  where-    v = vec (pos nv)-    x = vx v-    y = vy v-    z = vz v-    h = height nv-showV (Trk t) s =-    "track:" ++-    "\n      position: " ++-    showLl (fromNVector . trackPos $ t :: LatLong) ++-    "\n      height  : " ++-    showLength (height . trackPos $ t) s ++-    "\n      bearing : " ++-    showAng (trackBearing t) ++ "\n      speed   : " ++ showSpeed (trackSpeed t) s-showV (Spd spd) s = "speed: " ++ showSpeed spd s-showV (Vals []) _ = "empty"-showV (Vals vs) s = "\n  " ++ intercalate "\n\n  " (map (`showV` s) vs)--showAng :: Angle -> String-showAng a = show a ++ " (" ++ show (toDecimalDegrees a) ++ ")"--showLl :: LatLong -> String-showLl ll =-    show ll ++-    " (" ++-    show (toDecimalDegrees (latitude ll)) ++ ", " ++ show (toDecimalDegrees (longitude ll)) ++ ")"
− app/State.hs 
@@ -1,133 +0,0 @@--- |
--- Module:      State
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- REPL state.
---
-module State
-    ( State
-    , emptyState
-    , Value(..)
-    , setUnits
-    , lengthUnit
-    , speedUnit
-    , showLength
-    , showSpeed
-    , insert
-    , delete
-    , lookup
-    ) where
-
-import Control.Applicative
-import Data.Char (isLetter)
-import Data.Geo.Jord
-import Data.List hiding (delete, insert, lookup)
-import Data.Maybe (fromMaybe)
-import Prelude hiding (lookup)
-
--- | REPL state.
-data State =
-    State Units
-          Vault
-
--- | A value accepted and returned by 'eval'.
-data Value
-    = Ang Angle -- ^ angle
-    | Bool Bool -- ^ boolean
-    | Cpa (Cpa (AngularPosition NVector)) -- ^ CPA
-    | Dlt Delta -- ^ delta
-    | Dur Duration -- ^ duration
-    | Double Double -- ^ double
-    | Ep EcefPosition -- ^ ECEF position
-    | Em Earth -- ^ earth model
-    | FrmB Angle
-           Angle
-           Angle -- ^ yaw, pitch and roll of Body frame
-    | FrmL Angle -- ^ wander azimuth of Local frame
-    | FrmN -- ^ North, east, down frame
-    | Ga GreatArc -- ^ great arc
-    | Gc GreatCircle -- ^ great circle
-    | Gp (AngularPosition LatLong) -- ^ latitude, longitude and height
-    | Intp (Intercept (AngularPosition NVector)) -- ^ Intercept
-    | Len Length -- ^ length
-    | Ned Ned -- ^ north east down
-    | Np (AngularPosition NVector) -- ^ n-vector and height
-    | Spd Speed -- ^ speed
-    | Trk (Track (AngularPosition NVector)) -- ^ track
-    | Vals [Value] -- array of values
-
--- | A location for 'Value's to be shared by successive evalations.
-newtype Vault =
-    Vault [(String, Value)]
-
--- | functions to show values with a pre-defined unit.
-data Units =
-    Units (Length -> String)
-          (Speed -> String)
-
--- | empty state: length in kilometres, speed in kilometres/hour and empty vault.
-emptyState :: State
-emptyState = State (Units len spd) (Vault [])
-  where
-    len l = show (toKilometres l) ++ "km"
-    spd s = show (toKilometresPerHour s) ++ "km/h"
-
--- | sets length and or speed units, ignore all invalid units.
-setUnits :: [String] -> State -> State
-setUnits us (State (Units l s) v) = State (Units (fromMaybe l lu) (fromMaybe s su)) v
-  where
-    lu = foldl (<|>) Nothing (fmap toLenUnit us)
-    su = foldl (<|>) Nothing (fmap toSpdUnit us)
-
-toLenUnit :: String -> Maybe (Length -> String)
-toLenUnit "m" = Just (\l -> show (toMetres l) ++ "m")
-toLenUnit "km" = Just (\l -> show (toKilometres l) ++ "km")
-toLenUnit "nm" = Just (\l -> show (toNauticalMiles l) ++ "nm")
-toLenUnit "ft" = Just (\l -> show (toFeet l) ++ "ft")
-toLenUnit _ = Nothing
-
-toSpdUnit :: String -> Maybe (Speed -> String)
-toSpdUnit "m/s" = Just (\l -> show (toMetresPerSecond l) ++ "m/s")
-toSpdUnit "km/h" = Just (\l -> show (toKilometresPerHour l) ++ "km/h")
-toSpdUnit "mph" = Just (\l -> show (toMilesPerHour l) ++ "mph")
-toSpdUnit "kt" = Just (\l -> show (toKnots l) ++ "kt")
-toSpdUnit "ft/s" = Just (\l -> show (toFeetPerSecond l) ++ "ft/s")
-toSpdUnit _ = Nothing
-
--- | length unit.
-lengthUnit :: State -> String
-lengthUnit s = filter isLetter (showLength zero s)
-
--- | speed unit.
-speedUnit :: State -> String
-speedUnit s = filter (\c -> isLetter c || c == '/') (showSpeed zero s)
-
--- | show length in selected unit.
-showLength :: Length -> State -> String
-showLength l (State (Units len _) _) = len l
-
--- | show speed in selected unit.
-showSpeed :: Speed -> State -> String
-showSpeed s (State (Units _ spd) _) = spd s
-
--- | @insert k v state@ inserts value @v@ for key @k@. Overwrites any previous value.
-insert :: String -> Value -> State -> State
-insert k v (State u vault) = State u (Vault (e ++ [(k, v)]))
-  where
-    Vault e = delete' k vault
-
--- | @lookup k state@ looks up the value of key @k@ in the vault.
-lookup :: String -> State -> Maybe Value
-lookup k (State _ (Vault es)) = fmap snd (find (\e -> fst e == k) es)
-
--- | @delete k state@ deletes key @k@ from the vault.
-delete :: String -> State -> State
-delete k (State u v) = State u (delete' k v)
-
--- | @delete k vault@ deletes key @k@ from the vault.
-delete' :: String -> Vault -> Vault
-delete' k (Vault es) = Vault (filter (\e -> fst e /= k) es)
+ benchmarks/GeodesicBG.hs view
@@ -0,0 +1,35 @@+module GeodesicBG
+    ( benchmark
+    ) where
+
+import Criterion.Types
+import Data.Geo.Jord.Geodesic
+import Data.Geo.Jord.Position
+
+benchmark :: Benchmark
+benchmark =
+    bgroup
+        "Geodesic"
+        [ bench "direct" $ whnf (directGeodesic p1 b1) d1
+        , bench "inverse" $ whnf (inverseGeodesic p1) p2
+        , bench "inverse antipodal" $ whnf (inverseGeodesic p1) (antipode p1)
+        , bench "inverse near-antipodal" $ whnf (inverseGeodesic p3) p4
+        ]
+
+p1 :: Position WGS84
+p1 = latLongPos (-37.95103341666667) 144.42486788888888 WGS84
+
+p2 :: Position WGS84
+p2 = latLongPos (-37.65282113888889) 143.92649552777777 WGS84
+
+d1 :: Length
+d1 = metres 54972.271139
+
+b1 :: Angle
+b1 = decimalDegrees 306.86815920333333
+
+p3 :: Position WGS84
+p3 = latLongPos 0 0 WGS84
+
+p4 :: Position WGS84
+p4 = latLongPos 0.5 179.5 WGS84
− benchmarks/GeodeticsBG.hs 
@@ -1,37 +0,0 @@-module GeodeticsBG
-    ( bggeodetics
-    ) where
-
-import Criterion.Types
-import Data.Geo.Jord
-
-bggeodetics :: Benchmark
-bggeodetics =
-    bgroup
-        "Geodetics"
-        [ bench "angularDistance" $ whnf (angularDistance nv1 nv2) (Just nv3)
-        , bench "crossTrackDistance" $ whnf (crossTrackDistance84 nv3) gc
-        , bench "destination" $ whnf (destination84 nv1 a) l
-        , bench "finalBearing" $ whnf (finalBearing nv1) nv2
-        , bench "initialBearing" $ whnf (initialBearing nv1) nv2
-        , bench "interpolate" $ whnf (interpolate nv1 nv2) 0.5
-        , bench "surfaceDistance" $ whnf (surfaceDistance84 nv1) nv2
-        ]
-
-nv1 :: NVector
-nv1 = nvector 0.5504083453140064 0.12711022980808237 0.8251627978083076
-
-nv2 :: NVector
-nv2 = nvector 0.484947835927087 0.1582112780286092 0.860113241343365
-
-nv3 :: NVector
-nv3 = nvector 0.5225962210695282 0.11083913756305296 0.8453448262739457
-
-gc :: GreatCircle
-gc = greatCircle (nv1, nv2)
-
-a :: Angle
-a = decimalDegrees 45.0
-
-l :: Length
-l = kilometres 5000
+ benchmarks/GreatCircleBG.hs view
@@ -0,0 +1,36 @@+module GreatCircleBG
+    ( benchmark
+    ) where
+
+import Criterion.Types
+import Data.Geo.Jord.GreatCircle
+import Data.Geo.Jord.Position
+
+benchmark :: Benchmark
+benchmark =
+    bgroup
+        "Great Circle"
+        [ bench "alongTrackDistance" $ whnf (alongTrackDistance' p1 p2) a
+        , bench "angularDistance" $ whnf (angularDistance p1 p2) (Just p3)
+        , bench "crossTrackDistance" $ whnf (crossTrackDistance' p1 p2) a
+        , bench "destination" $ whnf (destination p1 a) l
+        , bench "interpolate" $ whnf (interpolate p1 p2) 0.5
+        , bench "surfaceDistance" $ whnf (surfaceDistance p1) p2
+        , bench "finalBearing" $ whnf (finalBearing p1) p2
+        , bench "initialBearing" $ whnf (initialBearing p1) p2
+        ]
+
+p1 :: Position S84
+p1 = nvectorPos 0.5504083453140064 0.12711022980808237 0.8251627978083076 S84
+
+p2 :: Position S84
+p2 = nvectorPos 0.484947835927087 0.1582112780286092 0.860113241343365 S84
+
+p3 :: Position S84
+p3 = nvectorPos 0.5225962210695282 0.11083913756305296 0.8453448262739457 S84
+
+a :: Angle
+a = decimalDegrees 45.0
+
+l :: Length
+l = kilometres 5000
benchmarks/KinematicsBG.hs view
@@ -1,45 +1,46 @@ module KinematicsBG
-    ( bgkinematics
+    ( benchmark
     ) where
 
 import Criterion.Types
-import Data.Geo.Jord
+import Data.Geo.Jord.Kinematics
+import Data.Geo.Jord.Position
 
-bgkinematics :: Benchmark
-bgkinematics =
+benchmark :: Benchmark
+benchmark =
     bgroup
         "Kinematics"
         [ bgroup
               "CPA"
-              [ bench "in the past" $ whnf (cpa84 t1) t2
-              , bench "in the future" $ whnf (cpa84 t3) t4
-              , bench "same positions" $ whnf (cpa84 t1') t1
+              [ bench "in the past" $ whnf (cpa t1) t2
+              , bench "in the future" $ whnf (cpa t3) t4
+              , bench "same positions" $ whnf (cpa t1') t1
               ]
         , bgroup
               "intercept"
-              [ bench "min speed" $ whnf (intercept84 t5) ip1
-              , bench "by speed" $ whnf (interceptBySpeed84 t5 ip1) (knots 700)
-              , bench "by time" $ whnf (interceptByTime84 t5 ip1) (seconds 2700)
+              [ bench "min speed" $ whnf (intercept t5) ip1
+              , bench "by speed" $ whnf (interceptBySpeed t5 ip1) (knots 700)
+              , bench "by time" $ whnf (interceptByTime t5 ip1) (seconds 2700)
               ]
         ]
 
-t1 :: Track NVector
-t1 = Track (latLongToNVector (decimalLatLong 20 (-60))) (decimalDegrees 10) (knots 15)
+t1 :: Track S84
+t1 = Track (s84Pos 20 (-60) zero) (decimalDegrees 10) (knots 15)
 
-t1' :: Track NVector
-t1' = Track (latLongToNVector (decimalLatLong 20 (-60))) (decimalDegrees 10) (knots 15)
+t1' :: Track S84
+t1' = Track (s84Pos 20 (-60) zero) (decimalDegrees 10) (knots 15)
 
-t2 :: Track NVector
-t2 = Track (latLongToNVector (decimalLatLong 34 (-50))) (decimalDegrees 220) (knots 300)
+t2 :: Track S84
+t2 = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 300)
 
-t3 :: Track NVector
-t3 = Track (latLongToNVector (decimalLatLong 30 30)) (decimalDegrees 45) (knots 400)
+t3 :: Track S84
+t3 = Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400)
 
-t4 :: Track NVector
-t4 = Track (latLongToNVector (decimalLatLong 30.01 30)) (decimalDegrees 315) (knots 400)
+t4 :: Track S84
+t4 = Track (s84Pos 30.01 30 zero) (decimalDegrees 315) (knots 400)
 
-t5 :: Track NVector
-t5 = Track (latLongToNVector (decimalLatLong 34 (-50))) (decimalDegrees 220) (knots 600)
+t5 :: Track S84
+t5 = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
 
-ip1 :: NVector
-ip1 = latLongToNVector (decimalLatLong 20 (-60))
+ip1 :: Position S84
+ip1 = s84Pos 20 (-60) zero
benchmarks/Main.hs view
@@ -1,9 +1,11 @@ module Main where
 
 import Criterion.Main
-import GeodeticsBG
-import KinematicsBG
-import TransformationBG
 
+import qualified GeodesicBG
+import qualified GreatCircleBG
+import qualified KinematicsBG
+import qualified PositionBG
+
 main :: IO ()
-main = defaultMain [bggeodetics, bgkinematics, bgtransformation]
+main = defaultMain [GeodesicBG.benchmark, GreatCircleBG.benchmark, KinematicsBG.benchmark, PositionBG.benchmark]
+ benchmarks/PositionBG.hs view
@@ -0,0 +1,39 @@+module PositionBG
+    ( benchmark
+    ) where
+
+import Criterion.Types
+import Data.Geo.Jord.Position
+
+benchmark :: Benchmark
+benchmark =
+    bgroup
+        "Position"
+        [ bench "nvectorFromLatLong" $ whnf nvectorFromLatLong ll
+        , bench "nvectorToLatLong" $ whnf nvectorToLatLong nv
+        , bench "nvectorFromGeocentric (ellipsoidal)" $ whnf (`nvectorFromGeocentric` e) gce
+        , bench "nvectorToGeocentric (ellipsoidal)" $ whnf (`nvectorToGeocentric` e) (nv, h)
+        , bench "nvectorFromGeocentric (spherical)" $ whnf (`nvectorFromGeocentric` s) gcs
+        , bench "nvectorToGeocentric (spherical)" $ whnf (`nvectorToGeocentric` s) (nv, h)
+        ]
+
+ll :: (Angle, Angle)
+ll = (decimalDegrees 55.6050, decimalDegrees 13.0038)
+
+nv :: Vector3d
+nv = nvectorFromLatLong ll
+
+gce :: Vector3d
+gce = nvectorToGeocentric (nv, h) s
+
+gcs :: Vector3d
+gcs = nvectorToGeocentric (nv, h) e
+
+h :: Length
+h = metres 15000
+
+s :: Ellipsoid
+s = toSphere eWGS84
+
+e :: Ellipsoid
+e = eWGS84
− benchmarks/TransformationBG.hs 
@@ -1,36 +0,0 @@-module TransformationBG
-    ( bgtransformation
-    ) where
-
-import Criterion.Types
-import Data.Geo.Jord
-
-bgtransformation :: Benchmark
-bgtransformation =
-    bgroup
-        "Transformation"
-        [ bench "latLongToNVector" $ whnf latLongToNVector ll
-        , bench "nvectorToLatLong" $ whnf nvectorToLatLong nv
-        , bgroup
-              "Ellipsoidal"
-              [ bench "ecefToNVector" $ whnf (`ecefToNVector` wgs84) ep
-              , bench "nvectorToEcef" $ whnf (`nvectorToEcef` wgs84) ap
-              ]
-        , bgroup
-              "Spherical"
-              [ bench "ecefToNVector" $ whnf (`ecefToNVector` s84) ep
-              , bench "nvectorToEcef" $ whnf (`nvectorToEcef` s84) ap
-              ]
-        ]
-
-ll :: LatLong
-ll = decimalLatLong 55.6050 13.0038
-
-ap :: AngularPosition NVector
-ap = AngularPosition nv (metres 15000.0)
-
-nv :: NVector
-nv = nvector 0.5 0.5 0.7071
-
-ep :: EcefPosition
-ep = ecefMetres 5733855.7748 (-6370998.3802) 7008137.5108
+ gen/Ellipsoids.hs view
@@ -0,0 +1,71 @@+module Ellipsoids
+    ( Ellipsoid(..)
+    , parser
+    , generator
+    ) where
+
+import Control.Applicative ((<|>))
+import Text.ParserCombinators.ReadP (ReadP, char, skipSpaces, string)
+
+import qualified Generator as G
+import qualified Parsers as P
+
+data Ellipsoid =
+    Ellipsoid
+        { name :: String
+        , comment :: [String]
+        , params :: Either (Double, Double) Double
+        }
+
+parser :: ReadP Ellipsoid
+parser = do
+    c <- P.comment
+    n <- P.name
+    P.eol
+    ps <- params'
+    P.eol
+    return (Ellipsoid n c ps)
+
+params' :: ReadP (Either (Double, Double) Double)
+params' = fmap Left eparams <|> fmap Right sparams
+
+eparams :: ReadP (Double, Double)
+eparams = do
+    skipSpaces
+    _ <- string "a:"
+    skipSpaces
+    a <- radius
+    P.eol
+    skipSpaces
+    _ <- string "1/f:"
+    skipSpaces
+    invf <- P.number
+    return (a, invf)
+
+sparams :: ReadP Double
+sparams = do
+    skipSpaces
+    _ <- string "r:"
+    skipSpaces
+    radius
+
+radius :: ReadP Double
+radius = do
+    d <- P.number
+    _ <- char 'm'
+    return d
+
+generator :: G.Generator Ellipsoid
+generator = G.Generator ["Data.Geo.Jord.Ellipsoid", "Data.Geo.Jord.Length"] genEllipsoid (const "")
+
+genEllipsoid :: Ellipsoid -> String
+genEllipsoid e =
+    G.documentation (comment e) ++ func e ++ " :: Ellipsoid" ++ "\n" ++ func e ++ " = " ++ value
+  where
+    value =
+        case params e of
+            Left (a, invf) -> "ellispoid (metres " ++ show a ++ ") " ++ show invf
+            Right r -> "sphere (metres " ++ show r ++ ")"
+
+func :: Ellipsoid -> String
+func e = "e" ++ name e
+ gen/Generator.hs view
@@ -0,0 +1,47 @@+module Generator
+    ( Header(..)
+    , Generator(..)
+    , generate
+    , documentation
+    ) where
+
+data Header =
+    Header
+        { comment :: [String]
+        , module' :: String
+        }
+
+data Generator a =
+    Generator [String] (a -> String) ([a] -> String)
+
+generate :: Header -> Generator a -> [a] -> String
+generate h (Generator imports genElt genAll) elts =
+    header h ++
+    "module " ++
+    module' h ++
+    " where\n\n" ++
+    unlines (map (\i -> "import " ++ i) imports) ++ "\n" ++ unlines (map (\e -> genElt e ++ "\n") elts) ++ genAll elts
+
+header :: Header -> String
+header h =
+    "-- | \n\
+    \-- Module:      " ++
+    module' h ++
+    " \n" ++
+    "-- Copyright:   (c) 2020 Cedric Liegeois \n\
+    \-- License:     BSD3 \n\
+    \-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr> \n\
+    \-- Stability:   experimental \n\
+    \-- Portability: portable \n\
+    \--\n" ++
+    genComment (comment h) ++
+    "--\n\
+    \-- This module has been generated.\n\
+    \--\n"
+
+documentation :: [String] -> String
+documentation [] = ""
+documentation (c:cs) = ("-- |" ++ c ++ "\n") ++ (genComment cs)
+
+genComment :: [String] -> String
+genComment cs = unlines (map (\s -> "--" ++ s) cs)
+ gen/Main.hs view
@@ -0,0 +1,52 @@+import System.Environment (getArgs)
+import System.IO (readFile, writeFile)
+import Text.ParserCombinators.ReadP (ReadP, many1, readP_to_S)
+
+import qualified Ellipsoids as E
+import Generator
+import qualified Models as M
+import qualified Parsers as P
+import qualified Transformations as T
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [inDir, outDir] -> do
+            ellipsoidsModule <- process (inDir ++ "/ellipsoids.txt") outDir E.parser E.generator
+            _ <- process (inDir ++ "/models.txt") outDir M.parser (M.generator ellipsoidsModule)
+            _ <- process (inDir ++ "/transformations.txt") outDir T.parser (T.generator)
+            return ()
+        _ -> putStrLn ("Invalid arguments: " ++ show args)
+
+process :: FilePath -> FilePath -> ReadP a -> Generator a -> IO String
+process inf outd p g = do
+    r <- parse p <$> readFile inf
+    case r of
+        Just (h, ps) -> do
+            writeFile (outf outd h) (generate h g ps)
+            return (module' h)
+        Nothing -> error ("invalid definition in " ++ show inf)
+
+parse :: ReadP a -> String -> Maybe (Header, [a])
+parse p s =
+    case map fst $ filter (null . snd) $ readP_to_S (parser p) s of
+        [] -> Nothing
+        rs:_ -> Just rs
+
+parser :: ReadP a -> ReadP (Header, [a])
+parser p = do
+    hc <- P.comment
+    m <- P.module'
+    P.eol
+    es <- many1 p
+    return (Header hc m, es)
+
+outf :: FilePath -> Header -> FilePath
+outf d h = d ++ "/" ++ toPath (module' h) ++ ".hs"
+
+toPath :: String -> FilePath
+toPath m =
+    let repl '.' = '/'
+        repl c = c
+     in map repl m
+ gen/Models.hs view
@@ -0,0 +1,118 @@+module Models
+    ( Model(..)
+    , parser
+    , generator
+    ) where
+
+import Control.Applicative ((<|>))
+import Data.List (intercalate)
+import Text.ParserCombinators.ReadP (ReadP, choice, skipSpaces, string)
+
+import qualified Generator as G
+import qualified Parsers as P
+
+data Model =
+    Model
+        { mtype :: ModelType
+        , mid :: String
+        , comment :: [String]
+        , surface :: String
+        , longitudeRange :: String
+        , epoch :: Maybe Double
+        }
+
+data ModelType
+    = Spherical
+    | Ellipsoidal
+    deriving (Eq)
+
+parser :: ReadP Model
+parser = do
+    c <- P.comment
+    t <- type'
+    skipSpaces
+    n <- P.name
+    P.eol
+    s <- surface'
+    P.eol
+    lr <- longitudeRange'
+    ep <- maybeEpoch t
+    P.eol
+    return (Model t n c s lr ep)
+
+type' :: ReadP ModelType
+type' = do
+    s <- string "spherical " <|> string "ellipsoidal "
+    case s of
+        "spherical " -> return Spherical
+        "ellipsoidal " -> return Ellipsoidal
+        _ -> error "unsupported model type"
+
+surface' :: ReadP String
+surface' = do
+    skipSpaces
+    _ <- string "surface: "
+    P.name
+
+longitudeRange' :: ReadP String
+longitudeRange' = do
+    skipSpaces
+    _ <- string "longitudeRange: "
+    choice [string "L180", string "L360"]
+
+maybeEpoch :: ModelType -> ReadP (Maybe Double)
+maybeEpoch Spherical = return Nothing
+maybeEpoch _ = P.epoch
+
+generator :: String -> G.Generator Model
+generator ellipsoids =
+    G.Generator [ellipsoids, "Data.Geo.Jord.Ellipsoid", "Data.Geo.Jord.Model"] genModel (const "")
+
+genModel :: Model -> String
+genModel m = unlines' ([d, model, eq, show'] ++ instanceType m)
+  where
+    d = G.documentation (comment m) ++ "data " ++ mid m ++ " = " ++ "\n" ++ "    " ++ mid m
+    model = instanceModel m
+    eq = instanceEq m
+    show' = instanceShow m
+
+instanceModel :: Model -> String
+instanceModel m =
+    "instance Model " ++
+    mid m ++
+    " where\n" ++
+    "    modelId _ = ModelId \"" ++
+    mid m ++
+    "\"\n" ++ "    surface _ = " ++ s ++ "\n" ++ "    longitudeRange _ = " ++ longitudeRange m
+  where
+    s =
+        if mtype m == Spherical
+            then "toSphere e" ++ surface m
+            else "e" ++ surface m
+
+instanceEq :: Model -> String
+instanceEq m = "instance Eq " ++ mid m ++ " where\n    _ == _ = True"
+
+instanceShow :: Model -> String
+instanceShow m = "instance Show " ++ mid m ++ " where\n    show m = show (modelId m)"
+
+instanceType :: Model -> [String]
+instanceType m
+    | mtype m == Spherical = instanceSpherical n
+    | mtype m == Ellipsoidal = instanceEllipsoidal n (epoch m)
+    | otherwise = error "unsupported type"
+  where
+    n = mid m
+
+instanceSpherical :: String -> [String]
+instanceSpherical n = ["instance Spherical " ++ n]
+
+instanceEllipsoidal :: String -> Maybe Double -> [String]
+instanceEllipsoidal n Nothing = ["instance Ellipsoidal " ++ n]
+instanceEllipsoidal n (Just yd) =
+    [ "instance Ellipsoidal " ++ n
+    , "instance EllipsoidalT0 " ++ n ++ " where\n" ++ "    epoch _ = Epoch " ++ show yd
+    ]
+
+unlines' :: [String] -> String
+unlines' = intercalate "\n\n"
+ gen/Parsers.hs view
@@ -0,0 +1,84 @@+module Parsers
+    ( comment
+    , name
+    , number
+    , integer
+    , eol
+    , module'
+    , epoch
+    ) where
+
+import Control.Applicative ((<|>))
+import Data.Char (isAlpha, isAlphaNum, isDigit)
+import Data.List (stripPrefix)
+import Data.Maybe (isJust)
+import Text.ParserCombinators.ReadP
+    ( ReadP
+    , char
+    , look
+    , many
+    , many1
+    , munch1
+    , option
+    , satisfy
+    , skipSpaces
+    , string
+    )
+
+comment :: ReadP [String]
+comment = many commentL
+
+commentL :: ReadP String
+commentL = do
+    _ <- char '#'
+    c <- many (satisfy (\c -> c /= '\n' && c /= '\r'))
+    eol
+    return c
+
+name :: ReadP String
+name = many1 (satisfy (\c -> c == '_' || isAlphaNum c))
+
+number :: ReadP Double
+number = double <|> fmap fromIntegral integer
+
+double :: ReadP Double
+double = do
+    s <- option 1.0 (fmap (\_ -> -1.0) (char '-'))
+    i <- natural
+    f <- char '.' >> munch1 isDigit
+    return (s * (read (show i ++ "." ++ f) :: Double))
+
+integer :: ReadP Int
+integer = do
+    s <- option 1 (fmap (\_ -> -1) (char '-'))
+    p <- natural
+    return (s * p)
+
+natural :: ReadP Int
+natural = fmap read (munch1 isDigit)
+
+eol :: ReadP ()
+eol = do
+    _ <- many1 (char '\n' <|> (char '\r' >> char '\n'))
+    return ()
+
+module' :: ReadP String
+module' = do
+    _ <- string "module "
+    many1 (satisfy (\c -> c == '.' || isAlphaNum c))
+
+epoch :: ReadP (Maybe Double)
+epoch = do
+    n <- look
+    if hasEpoch n
+        then fmap Just epoch'
+        else return Nothing
+
+hasEpoch :: String -> Bool
+hasEpoch s = isJust (stripPrefix "epoch" (dropWhile (not . isAlpha) s))
+
+epoch' :: ReadP Double
+epoch' = do
+    skipSpaces
+    _ <- string "epoch: "
+    double
+ gen/Transformations.hs view
@@ -0,0 +1,158 @@+module Transformations
+    ( Transformation(..)
+    , parser
+    , generator
+    ) where
+
+import Data.List (intercalate, partition)
+import Data.Maybe (isJust)
+import Text.ParserCombinators.ReadP (ReadP, skipSpaces, string)
+
+import qualified Generator as G
+import qualified Parsers as P
+
+data Params =
+    Params [Double] Double [Double]
+
+data Transformation =
+    Transformation
+        { comment :: [String]
+        , from :: String
+        , to :: String
+        , epoch :: Maybe Double
+        , params :: Params
+        , rates :: Params
+        }
+
+parser :: ReadP Transformation
+parser = do
+    c <- P.comment
+    f <- P.name
+    _ <- string " -> "
+    t <- P.name
+    P.eol
+    me <- P.epoch
+    case me of
+        Nothing -> do
+            ps <- params' "params:"
+            P.eol
+            return (Transformation c f t Nothing ps noRates)
+        (Just _) -> do
+            P.eol
+            ps <- params' "params:"
+            rs <- params' "rates:"
+            P.eol
+            return (Transformation c f t me ps rs)
+
+noRates :: Params
+noRates = Params [] 0.0 []
+
+params' :: String -> ReadP Params
+params' n = do
+    skipSpaces
+    _ <- string n
+    skipSpaces
+    tx <- P.number
+    skipSpaces
+    ty <- P.number
+    skipSpaces
+    tz <- P.number
+    skipSpaces
+    s <- P.number
+    skipSpaces
+    rx <- P.number
+    skipSpaces
+    ry <- P.number
+    skipSpaces
+    rz <- P.number
+    return (Params [tx, ty, tz] s [rx, ry, rz])
+
+generator :: G.Generator Transformation
+generator = G.Generator ["Data.Geo.Jord.Model", "Data.Geo.Jord.Tx"] genTx genAll
+
+genTx :: Transformation -> String
+genTx t
+    | isJust (epoch t) = dynamicTx t
+    | otherwise = staticTx t
+
+dynamicTx :: Transformation -> String
+dynamicTx t =
+    G.documentation (comment t) ++
+    func t ++
+    " :: Tx TxParams15\n" ++
+    func t ++
+    " =\n    Tx " ++
+    idToString (from t) ++
+    "\n        " ++
+    idToString (to t) ++
+    "\n        " ++
+    "(TxParams15" ++
+    "\n             " ++
+    epochToString (epoch t) ++
+    "\n             " ++
+    tx7ToString (params t) ++ "\n             " ++ ratesToString (rates t) ++ ")"
+
+staticTx :: Transformation -> String
+staticTx t =
+    G.documentation (comment t) ++
+    func t ++
+    " :: Tx TxParams7\n" ++
+    func t ++
+    " =\n    Tx " ++
+    idToString (from t) ++
+    "\n        " ++ idToString (to t) ++ "\n        " ++ tx7ToString (params t)
+
+idToString :: String -> String
+idToString s = "(ModelId \"" ++ s ++ "\")"
+
+tx7ToString :: Params -> String
+tx7ToString (Params t s r) =
+    "(txParams7 " ++ dsToString t ++ " " ++ dToString s ++ " " ++ dsToString r ++ ")"
+
+ratesToString :: Params -> String
+ratesToString (Params t s r) =
+    "(txRates " ++ dsToString t ++ " " ++ dToString s ++ " " ++ dsToString r ++ ")"
+
+dsToString :: [Double] -> String
+dsToString ds = "(" ++ intercalate ", " (map show ds) ++ ")"
+
+dToString :: Double -> String
+dToString d
+    | d < 0 = "(" ++ show d ++ ")"
+    | otherwise = show d
+
+func :: Transformation -> String
+func t = "from_" ++ from t ++ "_to_" ++ to t
+
+epochToString :: Maybe Double -> String
+epochToString Nothing = error "no epoch"
+epochToString (Just yd) = "(Epoch " ++ show yd ++ ")"
+
+genAll :: [Transformation] -> String
+genAll ts = genStaticTxs s ++ "\n" ++ genDynamicTxs d
+  where
+    (d, s) = split ts
+
+genStaticTxs :: [Transformation] -> String
+genStaticTxs ts =
+    "-- | Graph of all static transformations.\n\
+   \staticTxs :: TxGraph TxParams7\n\
+   \staticTxs =\n\
+   \    txGraph\n\
+   \        [ " ++
+    funcs ts ++ "\n        ]\n"
+
+genDynamicTxs :: [Transformation] -> String
+genDynamicTxs ts =
+    "-- | Graph of all dynamic transformations.\n\
+   \dynamicTxs :: TxGraph TxParams15\n\
+   \dynamicTxs =\n\
+   \    txGraph\n\
+   \        [ " ++
+    funcs ts ++ "\n        ]\n"
+
+funcs :: [Transformation] -> String
+funcs ts = intercalate "\n        , " (map func ts)
+
+split :: [Transformation] -> ([Transformation], [Transformation])
+split = partition (isJust . epoch)
jord.cabal view
@@ -1,114 +1,122 @@-cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.31.1.------ see: https://github.com/sol/hpack------ hash: a4e2fc2a432aee57ca9f6d714df611ac3368d7470ccda202db3f966a3d6934e4--name:           jord-version:        0.6.0.0-synopsis:       Geographical Position Calculations-description:    Please see the README on GitHub at <https://github.com/ofmooseandmen/jord#readme>-category:       Geography-stability:      experimental-homepage:       https://github.com/ofmooseandmen/jord-bug-reports:    https://github.com/ofmooseandmen/jord/issues-author:         Cedric Liegeois-maintainer:     Cedric Liegeois <ofmooseandmen@yahoo.com>-copyright:      2018 Cedric Liegeois-license:        BSD3-license-file:   LICENSE-build-type:     Simple-extra-source-files:-    README.md-    ChangeLog.md--source-repository head-  type: git-  location: https://github.com/ofmooseandmen/jord--library-  exposed-modules:-      Data.Geo.Jord-      Data.Geo.Jord.Angle-      Data.Geo.Jord.AngularPosition-      Data.Geo.Jord.Duration-      Data.Geo.Jord.Earth-      Data.Geo.Jord.EcefPosition-      Data.Geo.Jord.Frames-      Data.Geo.Jord.Geodetics-      Data.Geo.Jord.Kinematics-      Data.Geo.Jord.LatLong-      Data.Geo.Jord.Length-      Data.Geo.Jord.NVector-      Data.Geo.Jord.Quantity-      Data.Geo.Jord.Rotation-      Data.Geo.Jord.Speed-      Data.Geo.Jord.Transformation-      Data.Geo.Jord.Vector3d-  other-modules:-      Data.Geo.Jord.Internal-      Data.Geo.Jord.Parser-  hs-source-dirs:-      src-  ghc-options: -Wall-  build-depends:-      base >=4.9 && <5-  default-language: Haskell2010--executable jord-benchmarks-  main-is: Main.hs-  other-modules:-      GeodeticsBG-      KinematicsBG-      TransformationBG-  hs-source-dirs:-      benchmarks-  ghc-options: -Wall-  build-depends:-      base >=4.9 && <5-    , criterion-    , jord-  default-language: Haskell2010--executable jord-repl-  main-is: Main.hs-  other-modules:-      Eval-      Show-      State-  hs-source-dirs:-      app-  ghc-options: -Wall-  build-depends:-      base >=4.9 && <5-    , haskeline >=0.7 && <0.8-    , jord-  default-language: Haskell2010--test-suite jord-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs-  other-modules:-      Data.Geo.Jord.AngleSpec-      Data.Geo.Jord.DurationSpec-      Data.Geo.Jord.EarthSpec-      Data.Geo.Jord.FramesSpec-      Data.Geo.Jord.GeodeticsSpec-      Data.Geo.Jord.KinematicsSpec-      Data.Geo.Jord.LatLongSpec-      Data.Geo.Jord.LengthSpec-      Data.Geo.Jord.RotationSpec-      Data.Geo.Jord.SpeedSpec-      Data.Geo.Jord.TransformationSpec-      Paths_jord-  hs-source-dirs:-      test-  ghc-options: -Wall-  build-depends:-      HUnit ==1.6.*-    , base >=4.9 && <5-    , hspec ==2.*-    , jord-  default-language: Haskell2010+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: cc409401d6b89737876c63a8e5e48fe917e301badede3ca5f9a2a7406b815276
+
+name:           jord
+version:        1.0.0.0
+synopsis:       Geographical Position Calculations
+description:    Please see the README on GitHub at <https://github.com/ofmooseandmen/jord#readme>
+category:       Geography
+stability:      experimental
+homepage:       https://github.com/ofmooseandmen/jord
+bug-reports:    https://github.com/ofmooseandmen/jord/issues
+author:         Cedric Liegeois
+maintainer:     Cedric Liegeois <ofmooseandmen@yahoo.com>
+copyright:      2020 Cedric Liegeois
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/ofmooseandmen/jord
+
+library
+  exposed-modules:
+      Data.Geo.Jord
+      Data.Geo.Jord.Angle
+      Data.Geo.Jord.Duration
+      Data.Geo.Jord.Ellipsoid
+      Data.Geo.Jord.Ellipsoids
+      Data.Geo.Jord.Geodesic
+      Data.Geo.Jord.GreatCircle
+      Data.Geo.Jord.Kinematics
+      Data.Geo.Jord.LatLong
+      Data.Geo.Jord.Length
+      Data.Geo.Jord.LocalFrames
+      Data.Geo.Jord.Model
+      Data.Geo.Jord.Models
+      Data.Geo.Jord.Position
+      Data.Geo.Jord.Quantity
+      Data.Geo.Jord.Rotation
+      Data.Geo.Jord.Speed
+      Data.Geo.Jord.Transformation
+      Data.Geo.Jord.Txs
+      Data.Geo.Jord.Tx
+      Data.Geo.Jord.Vector3d
+  other-modules:
+      Data.Geo.Jord.Parser
+      Data.Geo.Jord.Internal
+  hs-source-dirs:
+      src
+  ghc-options: -Wall
+  build-depends:
+      base >=4.9 && <5
+  default-language: Haskell2010
+
+executable jord-benchmarks
+  main-is: Main.hs
+  other-modules:
+      GeodesicBG
+      GreatCircleBG
+      KinematicsBG
+      PositionBG
+  hs-source-dirs:
+      benchmarks
+  ghc-options: -Wall
+  build-depends:
+      base >=4.9 && <5
+    , criterion
+    , jord
+  default-language: Haskell2010
+
+executable jord-gen
+  main-is: Main.hs
+  other-modules:
+      Ellipsoids
+      Generator
+      Models
+      Parsers
+      Transformations
+  hs-source-dirs:
+      gen
+  ghc-options: -Wall
+  build-depends:
+      base >=4.9 && <5
+  default-language: Haskell2010
+
+test-suite jord-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Data.Geo.Jord.AngleSpec
+      Data.Geo.Jord.DurationSpec
+      Data.Geo.Jord.EllipsoidSpec
+      Data.Geo.Jord.GeodesicSpec
+      Data.Geo.Jord.GreatCircleSpec
+      Data.Geo.Jord.KinematicsSpec
+      Data.Geo.Jord.LengthSpec
+      Data.Geo.Jord.LocalFramesSpec
+      Data.Geo.Jord.PositionSpec
+      Data.Geo.Jord.ReadPositionSpec
+      Data.Geo.Jord.RotationSpec
+      Data.Geo.Jord.ShowPositionSpec
+      Data.Geo.Jord.SpeedSpec
+      Data.Geo.Jord.TransformationSpec
+      Paths_jord
+  hs-source-dirs:
+      test
+  ghc-options: -Wall
+  build-depends:
+      HUnit ==1.6.*
+    , base >=4.9 && <5
+    , hspec ==2.*
+    , jord
+  default-language: Haskell2010
src/Data/Geo/Jord.hs view
@@ -1,58 +1,82 @@ -- |
 -- Module:      Data.Geo.Jord
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
 -- Portability: portable
 --
--- Geographic position calculations (distance, bearing, intersection, etc...) on great circles using
--- the algorithms described in <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>.
--- and in <https://calhoun.nps.edu/bitstream/handle/10945/29516/sometacticalalgo00shud.pdf Shudde, Rex H. (1986). Some tactical algorithms for spherical geometry>
+-- Convience module re-exporting all of Jord API while resolving function name clashes.
+-- You'll probably rather want to import "Data.Geo.Jord.Position" and only the core module(s)
+-- that suit your problem:
 --
--- See <http://www.navlab.net/nvector Position calculations - simple and exact solutions>
+--    * "Data.Geo.Jord.LocalFrames"
 --
--- See <http://www.movable-type.co.uk/scripts/latlong-vectors.html Vector-based geodesy>
+--    * "Data.Geo.Jord.Geodesic"
 --
--- See <http://clynchg3c.com/Technote/geodesy/coorddef.pdf Earth Coordinates>
+--    * "Data.Geo.Jord.GreatCircle"
 --
+--    * "Data.Geo.Jord.Kinematics"
+--
+--    * "Data.Geo.Jord.Transformation"
+--
 module Data.Geo.Jord
-    ( module Data.Geo.Jord.Angle
-    , module Data.Geo.Jord.AngularPosition
-    , module Data.Geo.Jord.Duration
-    , module Data.Geo.Jord.Earth
-    , module Data.Geo.Jord.EcefPosition
-    , module Data.Geo.Jord.Frames
-    , module Data.Geo.Jord.Geodetics
+    (
+    -- * Core modules
+      module Data.Geo.Jord.LocalFrames
+    , module Data.Geo.Jord.Geodesic
+    , module Data.Geo.Jord.GreatCircle
     , module Data.Geo.Jord.Kinematics
-    , module Data.Geo.Jord.LatLong
-    , module Data.Geo.Jord.Length
-    , module Data.Geo.Jord.NVector
-    , module Data.Geo.Jord.Quantity
-    , module Data.Geo.Jord.Rotation
-    , module Data.Geo.Jord.Speed
+    , module Data.Geo.Jord.Position
     , module Data.Geo.Jord.Transformation
-    , module Data.Geo.Jord.Vector3d
-    , jordVersion
+    -- * Aliases for name-clashing functions
+    , destinationE
+    , finalBearingE
+    , initialBearingE
+    , surfaceDistanceE
+    , destinationS
+    , finalBearingS
+    , initialBearingS
+    , surfaceDistanceS
     ) where
 
-import Data.Geo.Jord.Angle
-import Data.Geo.Jord.AngularPosition
-import Data.Geo.Jord.Duration
-import Data.Geo.Jord.Earth
-import Data.Geo.Jord.EcefPosition
-import Data.Geo.Jord.Frames
-import Data.Geo.Jord.Geodetics
+import Data.Geo.Jord.Geodesic hiding (destination, finalBearing, initialBearing, surfaceDistance)
+import qualified Data.Geo.Jord.Geodesic as Geodesic
+import Data.Geo.Jord.GreatCircle hiding (destination, finalBearing, initialBearing, surfaceDistance)
+import qualified Data.Geo.Jord.GreatCircle as GreatCircle
 import Data.Geo.Jord.Kinematics
-import Data.Geo.Jord.LatLong
-import Data.Geo.Jord.Length
-import Data.Geo.Jord.NVector
-import Data.Geo.Jord.Quantity
-import Data.Geo.Jord.Rotation
-import Data.Geo.Jord.Speed
+import Data.Geo.Jord.LocalFrames
+import Data.Geo.Jord.Position
 import Data.Geo.Jord.Transformation
-import Data.Geo.Jord.Vector3d
 
--- | version.
-jordVersion :: String
-jordVersion = "0.6.0.0"
+-- | alias for 'Geodesic.destination'.
+destinationE :: (Ellipsoidal a) => Position a -> Angle -> Length -> Maybe (Position a)
+destinationE = Geodesic.destination
+
+-- | alias for 'Geodesic.finalBearing'.
+finalBearingE :: (Ellipsoidal a) => Position a -> Position a -> Maybe Angle
+finalBearingE = Geodesic.finalBearing
+
+-- | alias for 'Geodesic.initialBearing'.
+initialBearingE :: (Ellipsoidal a) => Position a -> Position a -> Maybe Angle
+initialBearingE = Geodesic.initialBearing
+
+-- | alias for 'Geodesic.surfaceDistance'.
+surfaceDistanceE :: (Ellipsoidal a) => Position a -> Position a -> Maybe Length
+surfaceDistanceE = Geodesic.surfaceDistance
+
+-- | alias for 'GreatCircle.destination'.
+destinationS :: (Spherical a) => Position a -> Angle -> Length -> Position a
+destinationS = GreatCircle.destination
+
+-- | alias for 'GreatCircle.finalBearing'.
+finalBearingS :: (Spherical a) => Position a -> Position a -> Maybe Angle
+finalBearingS = GreatCircle.finalBearing
+
+-- | alias for 'GreatCircle.initialBearing'.
+initialBearingS :: (Spherical a) => Position a -> Position a -> Maybe Angle
+initialBearingS = GreatCircle.initialBearing
+
+-- | alias for 'GreatCircle.surfaceDistance'.
+surfaceDistanceS :: (Spherical a) => Position a -> Position a -> Length
+surfaceDistanceS = GreatCircle.surfaceDistance
src/Data/Geo/Jord/Angle.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Angle
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -15,8 +15,6 @@     -- * Smart constructors
     , decimalDegrees
     , dms
-    , dmsE
-    , dmsF
     , radians
     -- * Calculations
     , arcLength
@@ -32,110 +30,83 @@     , sin'
     -- * Accessors
     , getDegrees
-    , getMinutes
-    , getSeconds
-    , getMilliseconds
+    , getArcminutes
+    , getArcseconds
+    , getArcmilliseconds
     -- * Conversions
     , toDecimalDegrees
     , toRadians
     -- * Read
-    , angle
+    , angleP
     , readAngle
-    , readAngleE
-    , readAngleF
     ) where
 
-import Control.Applicative
-import Control.Monad.Fail
-import Data.Fixed
+import Control.Applicative ((<|>))
+import Data.Fixed (mod')
+import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S, string)
+import Text.Printf (printf)
+import Text.Read (readMaybe)
+
 import Data.Geo.Jord.Length
 import Data.Geo.Jord.Parser
 import Data.Geo.Jord.Quantity
-import Data.Maybe
-import Prelude hiding (fail, length)
-import Text.ParserCombinators.ReadP
-import Text.Printf
-import Text.Read hiding (pfail)
 
--- | An angle with a resolution of a milliseconds of a degree.
+-- | An angle with a resolution of a microarcsecond.
 -- When used as a latitude/longitude this roughly translate to a precision
--- of 30 millimetres at the equator.
-newtype Angle = Angle
-    { milliseconds :: Int
-    } deriving (Eq)
+-- of 0.03 millimetres at the equator.
+newtype Angle =
+    Angle
+        { microarcseconds :: Int
+        }
+    deriving (Eq)
 
--- | See 'readAngle'.
+-- | See 'angleP'.
 instance Read Angle where
-    readsPrec _ = readP_to_S angle
+    readsPrec _ = readP_to_S angleP
 
--- | Angle is shown degrees, minutes, seconds and milliseconds - e.g. 154°25'43.5".
+-- | Show 'Angle' as degrees, minutes, seconds and milliseconds - e.g. 154°25'43.5".
 instance Show Angle where
     show a =
         s ++
         show d ++
         "°" ++
-        show (getMinutes a) ++
-        "'" ++ show (getSeconds a) ++ "." ++ printf "%03d" (getMilliseconds a) ++ "\""
+        show (getArcminutes a) ++
+        "'" ++ show (getArcseconds a) ++ "." ++ printf "%03d" (getArcmilliseconds a) ++ "\""
       where
         d = getDegrees a
         s =
-            if d == 0 && milliseconds a < 0
+            if d == 0 && microarcseconds a < 0
                 then "-"
                 else ""
 
+instance Ord Angle where
+    (<=) (Angle uas1) (Angle uas2) = uas1 <= uas2
+
 -- | Add/Subtract 'Angle's.
 instance Quantity Angle where
-    add (Angle millis1) (Angle millis2) = Angle (millis1 + millis2)
-    sub (Angle millis1) (Angle millis2) = Angle (millis1 - millis2)
+    add a1 a2 = Angle (microarcseconds a1 + microarcseconds a2)
+    sub a1 a2 = Angle (microarcseconds a1 - microarcseconds a2)
     zero = Angle 0
 
 -- | 'Angle' from given decimal degrees. Any 'Double' is accepted: it must be
 -- validated by the call site when used to represent a latitude or longitude.
 decimalDegrees :: Double -> Angle
-decimalDegrees dec = Angle (round (dec * 3600000.0))
-
--- | 'Angle' from the given degrees, minutes, seconds and milliseconds.
--- 'error's if given minutes, seconds and/or milliseconds are invalid.
--- Degrees are not validated and can be any 'Int': they must be validated by the call site
--- when used to represent a latitude or longitude.
-dms :: Int -> Int -> Int -> Int -> Angle
-dms degs mins secs millis =
-    fromMaybe
-        (error
-             ("Invalid minutes=" ++
-              show mins ++ " or seconds=" ++ show secs ++ " or milliseconds=" ++ show millis))
-        (dmsF degs mins secs millis)
+decimalDegrees dec = Angle (round (dec * 3600000000.0))
 
--- | 'Angle' from the given degrees, minutes, seconds and milliseconds.
--- A 'Left' indicates that given minutes, seconds and/or milliseconds are invalid.
--- Degrees are not validated and can be any 'Int': they must be validated by the call site
--- when used to represent a latitude or longitude.
-dmsE :: Int -> Int -> Int -> Int -> Either String Angle
-dmsE degs mins secs millis
-    | mins < 0 || mins > 59 = Left ("Invalid minutes: " ++ show mins)
-    | secs < 0 || secs >= 60 = Left ("Invalid seconds: " ++ show secs)
-    | millis < 0 || millis >= 1000 = Left ("Invalid milliseconds: " ++ show millis)
-    | otherwise = Right (decimalDegrees ms)
+-- | 'Angle' from the given degrees, arcminutes and __decimal__ arcseconds.
+-- A 'Left' indicates that given arcminutes and/or arcseconds are invalid.
+dms :: Int -> Int -> Double -> Either String Angle
+dms degs mins secs
+    | mins < 0 || mins > 59 = Left ("Invalid arcminutes: " ++ show mins)
+    | secs < 0 || secs >= 60 = Left ("Invalid arcseconds: " ++ show secs)
+    | otherwise = Right (decimalDegrees d)
   where
-    ms =
+    d =
         signed
             (fromIntegral (abs degs) + (fromIntegral mins / 60.0 :: Double) +
-             (fromIntegral secs / 3600.0 :: Double) +
-             (fromIntegral millis / 3600000.0 :: Double))
+             (secs / 3600.0))
             (signum degs)
 
--- | 'Angle' from the given degrees, minutes, seconds and milliseconds.
--- 'fail's if given minutes, seconds and/or milliseconds are invalid.
--- Degrees are not validated and can be any 'Int': they must be validated by the call site
--- when used to represent a latitude or longitude.
-dmsF :: (MonadFail m) => Int -> Int -> Int -> Int -> m Angle
-dmsF degs mins secs millis =
-    case e of
-        Left err -> fail err
-        Right a -> return a
-  where
-    e = dmsE degs mins secs millis
-
 -- | 'Angle' from the given radians.
 radians :: Double -> Angle
 radians r = decimalDegrees (r / pi * 180.0)
@@ -188,27 +159,27 @@ 
 -- | Converts the given 'Angle' to decimal degrees.
 toDecimalDegrees :: Angle -> Double
-toDecimalDegrees (Angle millis) = fromIntegral millis / 3600000.0
+toDecimalDegrees (Angle uas) = fromIntegral uas / 3600000000.0
 
 -- | @getDegrees a@ returns the degree component of @a@.
 getDegrees :: Angle -> Int
-getDegrees a = signed (field a 3600000.0 360.0) (signum (milliseconds a))
+getDegrees a = signed (field a 3600000000.0 360.0) (signum (microarcseconds a))
 
--- | @getMinutes a@ returns the minute component of @a@.
-getMinutes :: Angle -> Int
-getMinutes a = field a 60000.0 60.0
+-- | @getArcminutes a@ returns the arcminute component of @a@.
+getArcminutes :: Angle -> Int
+getArcminutes a = field a 60000000.0 60.0
 
--- | @getSeconds a@ returns the second component of @a@.
-getSeconds :: Angle -> Int
-getSeconds a = field a 1000.0 60.0
+-- | @getArcseconds a@ returns the arcsecond component of @a@.
+getArcseconds :: Angle -> Int
+getArcseconds a = field a 1000000.0 60.0
 
--- | @getMilliseconds a@ returns the milliseconds component of @a@.
-getMilliseconds :: Angle -> Int
-getMilliseconds (Angle millis) = mod (abs millis) 1000
+-- | @getArcmilliseconds a@ returns the arcmilliseconds component of @a@.
+getArcmilliseconds :: Angle -> Int
+getArcmilliseconds a = field a 1000.0 1000.0
 
 field :: Angle -> Double -> Double -> Int
-field (Angle millis) divisor modulo =
-    truncate (mod' (fromIntegral (abs millis) / divisor) modulo) :: Int
+field (Angle uas) divisor modulo =
+    truncate (mod' (fromIntegral (abs uas) / divisor) modulo) :: Int
 
 signed :: (Num a, Num b, Ord b) => a -> b -> a
 signed n s
@@ -216,11 +187,9 @@     | otherwise = n
 
 -- | Parses and returns an 'Angle'.
-angle :: ReadP Angle
-angle = degsMinsSecs <|> decimal
-
--- | Obtains a 'Angle' from the given string formatted as either:
 --
+-- Supported formats:
+--
 --     * d°m′s.ms″ - e.g. 55°36'21.3", where minutes, seconds and milliseconds are optional.
 --
 --     * decimal° - e.g. 55.6050° or -133°
@@ -233,50 +202,38 @@ --
 --     * second: ", ″, '' or s
 --
--- This simply calls @read s :: Angle@ so 'error' should be handled at the call site.
---
-readAngle :: String -> Angle
-readAngle s = read s :: Angle
-
--- | Same as 'readAngle' but returns an 'Either'.
-readAngleE :: String -> Either String Angle
-readAngleE s =
-    case readMaybe s of
-        Nothing -> Left ("couldn't read angle " ++ s)
-        Just a -> Right a
+angleP :: ReadP Angle
+angleP = degsMinsSecs <|> decimal
 
--- | Same as 'readAngle' but returns a 'MonadFail'.
-readAngleF :: (MonadFail m) => String -> m Angle
-readAngleF s =
-    let p = readAngleE s
-     in case p of
-            Left e -> fail e
-            Right l -> return l
+-- | Reads an 'Angle' from the given string using 'angleP'.
+readAngle :: String -> Maybe Angle
+readAngle s = readMaybe s :: (Maybe Angle)
 
 -- | Parses DMS.MS and returns an 'Angle'.
 degsMinsSecs :: ReadP Angle
 degsMinsSecs = do
     d' <- fmap fromIntegral integer
     degSymbol
-    (m', s', ms') <- option (0, 0, 0) (minsSecs <|> minsOnly)
-    dmsF d' m' s' ms'
+    (m', s') <- option (0, 0.0) (minsSecs <|> minsOnly)
+    case dms d' m' s' of
+        Left err -> fail err
+        Right a -> return a
 
--- | Parses minutes, seconds with optionally milliseconds.
-minsSecs :: ReadP (Int, Int, Int)
+-- | Parses arcminutes and arcseconds.
+minsSecs :: ReadP (Int, Double)
 minsSecs = do
     m' <- natural
     minSymbol
-    s' <- natural
-    ms' <- option 0 (char '.' >> natural)
+    s' <- number
     secSymbol
-    return (m', s', ms')
+    return (m', s')
 
 -- | Parses minutes.
-minsOnly :: ReadP (Int, Int, Int)
+minsOnly :: ReadP (Int, Double)
 minsOnly = do
     m' <- natural
     minSymbol
-    return (m', 0, 0)
+    return (m', 0.0)
 
 -- | Parses decimal degrees.
 decimal :: ReadP Angle
− src/Data/Geo/Jord/AngularPosition.hs 
@@ -1,59 +0,0 @@--- |
--- Module:      Data.Geo.Jord.AngularPosition
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Angular positions.
---
--- See <http://clynchg3c.com/Technote/geodesy/coorddef.pdf Earth Coordinates>
---
-module Data.Geo.Jord.AngularPosition
-    ( AngularPosition(..)
-    , latLongHeight
-    , decimalLatLongHeight
-    , decimalLatLongHeightE
-    , decimalLatLongHeightF
-    , nvectorHeight
-    ) where
-
-import Control.Monad.Fail
-import Data.Geo.Jord.LatLong
-import Data.Geo.Jord.Length
-import Data.Geo.Jord.NVector
-
--- | An earth position defined by an horizontal position and height.
---
--- horizontal position can be either a 'LatLong' or a 'NVector'.
-data AngularPosition a = AngularPosition
-    { pos :: a
-    , height :: Length
-    } deriving (Eq, Show)
-
--- | 'AngularPosition' from a 'LatLong' and height.
-latLongHeight :: LatLong -> Length -> AngularPosition LatLong
-latLongHeight = AngularPosition
-
--- | 'AngularPosition' from given latitude and longitude in __decimal degrees__ and height.
--- 'error's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLongHeight :: Double -> Double -> Length -> AngularPosition LatLong
-decimalLatLongHeight lat lon = latLongHeight (decimalLatLong lat lon)
-
--- | 'AngularPosition' from given latitude and longitude in __decimal degrees__ and height.
--- A 'Left' indicates that the given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLongHeightE :: Double -> Double -> Length -> Either String (AngularPosition LatLong)
-decimalLatLongHeightE lat lon h = fmap (`latLongHeight` h) (decimalLatLongE lat lon)
-
--- | 'AngularPosition' from given latitude and longitude in __decimal degrees__ and height.
--- 'fail's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLongHeightF :: (MonadFail m) => Double -> Double -> Length -> m (AngularPosition LatLong)
-decimalLatLongHeightF lat lon h = fmap (`latLongHeight` h) (decimalLatLongF lat lon)
-
--- | 'AngularPosition' from a 'NVector' and height.
-nvectorHeight :: NVector -> Length -> AngularPosition NVector
-nvectorHeight = AngularPosition
src/Data/Geo/Jord/Duration.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Duration
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -24,29 +24,29 @@     , toMinutes
     , toSeconds
     -- * Read
+    , durationP
     , readDuration
-    , readDurationE
-    , readDurationF
     ) where
 
-import Control.Monad.Fail
+import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S)
+import Text.Printf (printf)
+import Text.Read (readMaybe)
+
 import Data.Geo.Jord.Parser
 import Data.Geo.Jord.Quantity
-import Prelude hiding (fail)
-import Text.ParserCombinators.ReadP
-import Text.Printf
-import Text.Read hiding (pfail)
 
--- | A durartion with a resolution of 1 millisecond.
-newtype Duration = Duration
-    { toMilliseconds :: Int -- ^ the number of milliseconds in duration.
-    } deriving (Eq)
+-- | A duration with a resolution of 1 millisecond.
+newtype Duration =
+    Duration
+        { toMilliseconds :: Int -- ^ the number of milliseconds in duration.
+        }
+    deriving (Eq)
 
--- | See 'readDuration'.
+-- | See 'durationP'.
 instance Read Duration where
-    readsPrec _ = readP_to_S duration
+    readsPrec _ = readP_to_S durationP
 
--- | show Duration as @(-)nHnMn.nS@.
+-- | Show 'Duration' as @(-)nHnMn.nS@.
 instance Show Duration where
     show d@(Duration millis) =
         show h ++ "H" ++ show m ++ "M" ++ show s ++ "." ++ printf "%03d" ms ++ "S"
@@ -56,6 +56,9 @@         s = truncate (fromIntegral (millis `mod` 60000) / 1000.0 :: Double) :: Int
         ms = mod (abs millis) 1000
 
+instance Ord Duration where
+    (<=) (Duration d1) (Duration d2) = d1 <= d2
+
 -- | Add/Subtract Durations.
 instance Quantity Duration where
     add a b = Duration (toMilliseconds a + toMilliseconds b)
@@ -94,31 +97,13 @@ toSeconds :: Duration -> Double
 toSeconds (Duration ms) = fromIntegral ms / 1000.0 :: Double
 
--- | Obtains a 'Duration' from the given string formatted @(-)nHnMn.nS@.
---
--- This simply calls @read s :: Duration@ so 'error' should be handled at the call site.
---
-readDuration :: String -> Duration
-readDuration s = read s :: Duration
-
--- | Same as 'readDuration' but returns a 'Either'.
-readDurationE :: String -> Either String Duration
-readDurationE s =
-    case readMaybe s of
-        Nothing -> Left ("couldn't read duration " ++ s)
-        Just l -> Right l
-
--- | Same as 'readDuration' but returns a 'MonadFail'.
-readDurationF :: (MonadFail m) => String -> m Duration
-readDurationF s =
-    let p = readEither s
-     in case p of
-            Left e -> fail e
-            Right l -> return l
+-- | Reads an a 'Duration' from the given string using 'durationP'.
+readDuration :: String -> Maybe Duration
+readDuration s = readMaybe s :: (Maybe Duration)
 
--- | Parses and returns an 'Duration'.
-duration :: ReadP Duration
-duration = do
+-- | Parses and returns an 'Duration' formatted @(-)nHnMn.nS@.
+durationP :: ReadP Duration
+durationP = do
     h <- option 0 hoursP
     m <- option 0 minutesP
     s <- option 0.0 secondsP
@@ -138,7 +123,6 @@ 
 secondsP :: ReadP Double
 secondsP = do
-    s <- integer
-    ms <- option 0 (char '.' >> natural)
+    s <- number
     _ <- char 'S'
-    return (fromIntegral s + fromIntegral ms / 10.0)
+    return s
− src/Data/Geo/Jord/Earth.hs 
@@ -1,121 +0,0 @@--- |
--- Module:      Data.Geo.Jord.Earth
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Ellipsoidal and derived spherical earth models.
---
-module Data.Geo.Jord.Earth
-    ( Earth(..)
-    , Ellipsoid(..)
-    , eccentricity
-    , meanRadius
-    , polarRadius
-    , spherical
-    -- * Reference ellipsoids.
-    , wgs84
-    , grs80
-    , wgs72
-    -- * Spherical models dervived from reference ellipsoids.
-    , s84
-    , s80
-    , s72
-    , r84
-    , r80
-    , r72
-    ) where
-
-import Data.Geo.Jord.Length
-
--- | Earth model: ellipsoidal or spherical.
-data Earth
-    = Ellipsoidal Ellipsoid
-    | Spherical Length
-    deriving (Eq, Show)
-
--- | Primary ellipsoid parameters.
-data Ellipsoid = Ellipsoid
-    { equatorialRadius :: Length -- ^ equatorial radius or semi-major axis (a).
-    , inverseFlattening :: Double -- ^ inverse flattening.
-    } deriving (Eq, Show)
-
--- | Computes the eccentricity of the given 'Earth' model.
-eccentricity :: Earth -> Double
-eccentricity (Ellipsoidal e) = sqrt (1.0 - (b * b) / (a * a))
-  where
-    a = semiMajorAxis e
-    b = semiMinorAxis a (flattening e)
-eccentricity (Spherical _) = 0
-
--- | Computes the mean radius of the given 'Earth' model.
---
--- This radius can be used for geodetic calculations assuming a spherical earth model.
-meanRadius :: Earth -> Length
-meanRadius (Ellipsoidal e) = metres ((2.0 * a + b) / 3.0)
-  where
-    a = semiMajorAxis e
-    b = semiMinorAxis a (flattening e)
-meanRadius (Spherical r) = r
-
--- | Computes the polar radius or semi-minor axis (b) of the given 'Earth' model.
-polarRadius :: Earth -> Length
-polarRadius (Ellipsoidal e) = metres (semiMinorAxis a f)
-  where
-    a = semiMajorAxis e
-    f = flattening e
-polarRadius (Spherical r) = r
-
--- | Spherical model derived from given model.
-spherical :: Earth -> Earth
-spherical e = Spherical (meanRadius e)
-
--- | World Geodetic System WGS84 ellipsoid.
-wgs84 :: Earth
-wgs84 = Ellipsoidal (Ellipsoid (metres 6378137.0) 298.257223563)
-
--- | Geodetic Reference System 1980 ellipsoid.
-grs80 :: Earth
-grs80 = Ellipsoidal (Ellipsoid (metres 6378137.0) 298.257222101)
-
--- | World Geodetic System WGS72 ellipsoid.
-wgs72 :: Earth
-wgs72 = Ellipsoidal (Ellipsoid (metres 6378135.0) 298.26)
-
--- | Spherical earth model derived from 'wgs84'.
-s84 :: Earth
-s84 = spherical wgs84
-
--- | Spherical earth model derived from 'grs80'.
-s80 :: Earth
-s80 = spherical grs80
-
--- | Spherical earth model derived from 'wgs72'.
-s72 :: Earth
-s72 = spherical wgs72
-
--- | Mean earth radius derived from the 'wgs84' ellipsoid.
-r84 :: Length
-r84 = meanRadius s84
-
--- | Mean earth radius derived from the 'grs80' ellipsoid.
-r80 :: Length
-r80 = meanRadius s80
-
--- | Mean earth radius derived from the 'wgs72' ellipsoid.
-r72 :: Length
-r72 = meanRadius s72
-
--- | semi-major axis (a) in metres.
-semiMajorAxis :: Ellipsoid -> Double
-semiMajorAxis = toMetres . equatorialRadius
-
--- | Computes the polar semi-minor axis (b) from semi major axis @a@ and flattening @f@.
-semiMinorAxis :: Double -> Double -> Double
-semiMinorAxis a f = a * (1.0 - f)
-
--- | flattening of ellispoid @e@
-flattening :: Ellipsoid -> Double
-flattening e = 1.0 / inverseFlattening e
− src/Data/Geo/Jord/EcefPosition.hs 
@@ -1,59 +0,0 @@--- |
--- Module:      Data.Geo.Jord.EcefPosition
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Earth Centred, Earth Fixed (ECEF) position.
---
--- See <http://clynchg3c.com/Technote/geodesy/coorddef.pdf Earth Coordinates>
---
-module Data.Geo.Jord.EcefPosition
-    ( EcefPosition
-    , ecef
-    , ecefMetres
-    , ex
-    , ey
-    , ez
-    ) where
-
-import Data.Geo.Jord.Length
-import Data.Geo.Jord.Vector3d
-
--- | An earth position expressed in the Earth Centred, Earth Fixed (ECEF) coordinates system.
---
--- @ex-ey@ plane is the equatorial plane, @ex@ is on the prime meridian, and @ez@ on the polar axis.
---
--- Note: on a spherical model earth, an /n/-vector is equivalent to a normalised version of an (ECEF) cartesian coordinate.
-newtype EcefPosition =
-    EcefPosition Vector3d
-    deriving (Eq, Show)
-
-instance IsVector3d EcefPosition where
-    vec (EcefPosition v) = v
-
--- | 'EcefPosition' from given x, y and z length.
---
--- @ex-ey@ plane is the equatorial plane, @ey@ is on the prime meridian, and @ez@ on the polar axis.
-ecef :: Length -> Length -> Length -> EcefPosition
-ecef x y z = EcefPosition (Vector3d (toMetres x) (toMetres y) (toMetres z))
-
--- | 'EcefPosition' from given x, y and z length in __metres__.
---
--- @ex-ey@ plane is the equatorial plane, @ey@ is on the prime meridian, and @ez@ on the polar axis.
-ecefMetres :: Double -> Double -> Double -> EcefPosition
-ecefMetres x y z = ecef (metres x) (metres y) (metres z)
-
--- | x coordinate of the given 'EcefPosition'.
-ex :: EcefPosition -> Length
-ex (EcefPosition v) = metres (vx v)
-
--- | y coordinate of the given 'EcefPosition'.
-ey :: EcefPosition -> Length
-ey (EcefPosition v) = metres (vy v)
-
--- | z coordinate of the given 'EcefPosition'.
-ez :: EcefPosition -> Length
-ez (EcefPosition v) = metres (vz v)
+ src/Data/Geo/Jord/Ellipsoid.hs view
@@ -0,0 +1,68 @@+-- |
+-- Module:      Data.Geo.Jord.Ellipsoid
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Types and functions for working with ellipsoids (including spheres).
+--
+-- see "Data.Geo.Jord.Ellipsoids" for supported ellipsoids.
+--
+module Data.Geo.Jord.Ellipsoid
+    ( Ellipsoid
+    , equatorialRadius
+    , polarRadius
+    , eccentricity
+    , flattening
+    , ellispoid
+    , sphere
+    , toSphere
+    , isSphere
+    , meanRadius
+    ) where
+
+import Data.Geo.Jord.Length
+
+-- | Parameters of an ellispoid describing the surface of a celestial body.
+--  An ellispoid is a circle if  its 'equatorialRadius' and 'polarRadius' are
+-- equal (both its 'eccentricity' and 'flattening' are 0); it is used to represent
+-- a celestial body as a sphere.
+data Ellipsoid =
+    Ellipsoid
+        { equatorialRadius :: !Length -- ^ equatorial radius or semi-major axis (a).
+        , polarRadius :: !Length -- ^ polar radius or semi-minor axis (b).
+        , eccentricity :: !Double -- ^ eccentricity
+        , flattening :: !Double -- ^ flattening
+        }
+    deriving (Eq, Show)
+
+-- | @ellispoid eqr invf@: ellipsoid with equatorial radius @eqr@ and inverse flattening @invf@.
+ellispoid :: Length -> Double -> Ellipsoid
+ellispoid eqr invf = Ellipsoid eqr (metres b) e f
+  where
+    a = toMetres eqr
+    f = 1.0 / invf
+    b = a * (1.0 - f)
+    e = sqrt (1.0 - (b * b) / (a * a))
+
+-- | @sphere r@: ellipsoid with equatorial & polar radius radius @r@.
+-- The returned ellipsoid is a sphere.
+sphere :: Length -> Ellipsoid
+sphere r = Ellipsoid r r 0.0 0.0
+
+-- | @toSphere e@: sphere from mean radius of ellipsoid @e@.
+toSphere :: Ellipsoid -> Ellipsoid
+toSphere = sphere . meanRadius
+
+-- | @isSphere e@ returns True if ellipsoid @e@ is a sphere.
+isSphere :: Ellipsoid -> Bool
+isSphere e = eccentricity e == 0.0
+
+-- | @meanRadius e@ computes the mean radius of ellipsoid @e@.
+meanRadius :: Ellipsoid -> Length
+meanRadius e = metres ((2.0 * a + b) / 3.0)
+  where
+    a = toMetres . equatorialRadius $ e
+    b = toMetres . polarRadius $ e
+ src/Data/Geo/Jord/Ellipsoids.hs view
@@ -0,0 +1,61 @@+-- | +-- Module:      Data.Geo.Jord.Ellipsoids +-- Copyright:   (c) 2020 Cedric Liegeois +-- License:     BSD3 +-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr> +-- Stability:   experimental +-- Portability: portable +--+-- Common ellipsoids of different celestial bodies.+--+-- This module has been generated.+--+module Data.Geo.Jord.Ellipsoids where++import Data.Geo.Jord.Ellipsoid+import Data.Geo.Jord.Length++-- | World Geodetic 84 Ellipsoid.+eWGS84 :: Ellipsoid+eWGS84 = ellispoid (metres 6378137.0) 298.257223563++-- | Geodetic Reference System 1980 Ellipsoid.+eGRS80 :: Ellipsoid+eGRS80 = ellispoid (metres 6378137.0) 298.257222101++-- | World Geodetic 72 Ellipsoid.+eWGS72 :: Ellipsoid+eWGS72 = ellispoid (metres 6378135.0) 298.26++-- | IUGG 1924 Ellipsoid.+eIntl1924 :: Ellipsoid+eIntl1924 = ellispoid (metres 6378388.0) 297.0++-- | Original definition Ellipsoid (1796).+eAiry1830 :: Ellipsoid+eAiry1830 = ellispoid (metres 6377563.396) 299.3249646++-- | Not specified, use only in cases where geodetic datum is unknown.+eAiryModified :: Ellipsoid+eAiryModified = ellispoid (metres 6377340.189) 299.3249646++-- | Bessel 1841 Ellipsoid.+eBessel1841 :: Ellipsoid+eBessel1841 = ellispoid (metres 6377397.155) 299.1528128++-- | Clarke (1866) Ellipsoid.+eClarke1866 :: Ellipsoid+eClarke1866 = ellispoid (metres 6378206.4) 294.978698214++-- |  Clarke (1880) Ellipsoid.+eClarke1880IGN :: Ellipsoid+eClarke1880IGN = ellispoid (metres 6378249.2) 293.466021294++-- | Mars Orbiter Laser Altimeter Ellipsoid.+eMars2000 :: Ellipsoid+eMars2000 = ellispoid (metres 3398627.0) 169.8++-- | Moon IAU/IAG Sphere.+eMoon :: Ellipsoid+eMoon = sphere (metres 1737400.0)+
− src/Data/Geo/Jord/Frames.hs 
@@ -1,321 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}
-
--- |
--- Module:      Data.Geo.Jord.Frames
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Type and functions for working with delta vectors in different reference frames.
---
--- All functions are implemented using the vector-based approached described in
--- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
---
-module Data.Geo.Jord.Frames
-    (
-    -- * Reference Frames
-      Frame(..)
-    -- ** Body frame
-    , FrameB
-    , yaw
-    , pitch
-    , roll
-    , frameB
-    -- ** Local frame
-    , FrameL
-    , wanderAzimuth
-    , frameL
-    -- ** North-East-Down frame
-    , FrameN
-    , frameN
-    -- * Deltas
-    , Delta
-    , delta
-    , deltaMetres
-    , dx
-    , dy
-    , dz
-    -- * Delta in the north, east, down frame
-    , Ned
-    , ned
-    , nedMetres
-    , north
-    , east
-    , down
-    , bearing
-    , elevation
-    , slantRange
-    -- * Calculations
-    , deltaBetween
-    , nedBetween
-    , target
-    , targetN
-    ) where
-
-import Data.Geo.Jord.Angle
-import Data.Geo.Jord.AngularPosition
-import Data.Geo.Jord.Earth
-import Data.Geo.Jord.EcefPosition
-import Data.Geo.Jord.LatLong
-import Data.Geo.Jord.Length
-import Data.Geo.Jord.NVector
-import Data.Geo.Jord.Rotation
-import Data.Geo.Jord.Transformation
-import Data.Geo.Jord.Vector3d
-
--- | class for reference frames.
---
--- Supported frames:
---
---     * 'FrameB': 'rEF' returns R_EB
---
---     * 'FrameL': 'rEF' returns R_EL
---
---     * 'FrameN': 'rEF' returns R_EN
---
-class Frame a where
-    rEF :: a -> [Vector3d] -- ^ rotation matrix to transform vectors decomposed in frame @a@ to vectors decomposed Earth-Fixed frame.
-
--- | Body frame (typically of a vehicle).
---
---     * Position: The origin is in the vehicle’s reference point.
---
---     * Orientation: The x-axis points forward, the y-axis to the right (starboard) and the z-axis
--- in the vehicle’s down direction.
---
---      * Comments: The frame is fixed to the vehicle.
---
-data FrameB = FrameB
-    { yaw :: Angle -- ^ body yaw angle (vertical axis).
-    , pitch :: Angle -- ^ body pitch angle (transverse axis).
-    , roll :: Angle -- ^ body roll angle (longitudinal axis).
-    , bOrg :: Vector3d -- ^ frame origin (n-vector).
-    } deriving (Eq, Show)
-
--- | 'FrameB' from given yaw, pitch, roll, position (origin) and earth model.
-frameB :: (ETransform a) => Angle -> Angle -> Angle -> a -> Earth -> FrameB
-frameB yaw' pitch' roll' p e = FrameB yaw' pitch' roll' (nvec p e)
-
--- | R_EB: frame B to Earth
-instance Frame FrameB where
-    rEF (FrameB y p r o) = rm
-      where
-        rNB = zyx2r y p r
-        n = FrameN o
-        rEN = rEF n
-        rm = mdot rEN rNB -- closest frames cancel: N
-
--- | Local level, Wander azimuth frame.
---
---     * Position: The origin is directly beneath or above the vehicle (B), at Earth’s surface (surface
--- of ellipsoid model).
---
---     * Orientation: The z-axis is pointing down. Initially, the x-axis points towards north, and the
--- y-axis points towards east, but as the vehicle moves they are not rotating about the z-axis
--- (their angular velocity relative to the Earth has zero component along the z-axis).
--- (Note: Any initial horizontal direction of the x- and y-axes is valid for L, but if the
--- initial position is outside the poles, north and east are usually chosen for convenience.)
---
---     * Comments: The L-frame is equal to the N-frame except for the rotation about the z-axis,
--- which is always zero for this frame (relative to Earth). Hence, at a given time, the only
--- difference between the frames is an angle between the x-axis of L and the north direction;
--- this angle is called the wander azimuth angle. The L-frame is well suited for general
--- calculations, as it is non-singular.
---
-data FrameL = FrameL
-    { wanderAzimuth :: Angle -- ^ wander azimuth: angle between x-axis of the frame L and the north direction.
-    , lOrg :: LatLong -- ^ frame origin (latlong).
-    } deriving (Eq, Show)
-
--- | R_EL: frame L to Earth
-instance Frame FrameL where
-    rEF (FrameL w o) = rm
-      where
-        r = xyz2r (longitude o) (negate' (latitude o)) w
-        rEe' = [Vector3d 0 0 (-1), Vector3d 0 1 0, Vector3d 1 0 0]
-        rm = mdot rEe' r
-
--- | 'FrameL' from given wander azimuth, position (origin) and earth model.
-frameL :: (ETransform a) => Angle -> a -> Earth -> FrameL
-frameL w p e = FrameL w ll
-  where
-    v = pos (ecefToNVector (toEcef p e) e)
-    ll = nvectorToLatLong v
-
--- | North-East-Down (local level) frame.
---
---     * Position: The origin is directly beneath or above the vehicle (B), at Earth’s surface (surface
--- of ellipsoid model).
---
---     * Orientation: The x-axis points towards north, the y-axis points towards east (both are
--- horizontal), and the z-axis is pointing down.
---
---     * Comments: When moving relative to the Earth, the frame rotates about its z-axis to allow the
--- x-axis to always point towards north. When getting close to the poles this rotation rate
--- will increase, being infinite at the poles. The poles are thus singularities and the direction of
--- the x- and y-axes are not defined here. Hence, this coordinate frame is not suitable for
--- general calculations.
---
-newtype FrameN = FrameN
-    { nOrg :: Vector3d -- ^ frame origin (n-vector).
-    } deriving (Eq, Show)
-
--- | R_EN: frame N to Earth
-instance Frame FrameN where
-    rEF (FrameN o) = transpose rm
-      where
-        np = vec northPole
-        rd = vscale o (-1) -- down (pointing opposite to n-vector)
-        re = vunit (vcross np o) -- east (pointing perpendicular to the plane)
-        rn = vcross re rd -- north (by right hand rule)
-        rm = [rn, re, rd]
-
--- | 'FrameN' from given position (origin) and earth model.
-frameN :: (ETransform a) => a -> Earth -> FrameN
-frameN p e = FrameN (nvec p e)
-
--- | delta between position in one of the reference frames.
-newtype Delta =
-    Delta Vector3d
-    deriving (Eq, Show)
-
--- | 'Delta' from given x, y and z length.
-delta :: Length -> Length -> Length -> Delta
-delta x y z = Delta (Vector3d (toMetres x) (toMetres y) (toMetres z))
-
--- | 'Delta' from given x, y and z length in __metres__.
-deltaMetres :: Double -> Double -> Double -> Delta
-deltaMetres x y z = delta (metres x) (metres y) (metres z)
-
--- | x component of given 'Delta'.
-dx :: Delta -> Length
-dx (Delta v) = metres (vx v)
-
--- | y component of given 'Delta'.
-dy :: Delta -> Length
-dy (Delta v) = metres (vy v)
-
--- | z component of given 'Delta'.
-dz :: Delta -> Length
-dz (Delta v) = metres (vz v)
-
--- | North, east and down delta (thus in frame 'FrameN').
-newtype Ned =
-    Ned Vector3d
-    deriving (Eq, Show)
-
--- | 'Ned' from given north, east and down.
-ned :: Length -> Length -> Length -> Ned
-ned n e d = Ned (Vector3d (toMetres n) (toMetres e) (toMetres d))
-
--- | 'Ned' from given north, east and down in __metres__.
-nedMetres :: Double -> Double -> Double -> Ned
-nedMetres n e d = ned (metres n) (metres e) (metres d)
-
--- | North component of given 'Ned'.
-north :: Ned -> Length
-north (Ned v) = metres (vx v)
-
--- | East component of given 'Ned'.
-east :: Ned -> Length
-east (Ned v) = metres (vy v)
-
--- | Down component of given 'Ned'.
-down :: Ned -> Length
-down (Ned v) = metres (vz v)
-
--- | @bearing v@ computes the bearing in compass angle of the NED vector @v@ from north.
---
--- Compass angles are clockwise angles from true north: 0 = north, 90 = east, 180 = south, 270 = west.
---
-bearing :: Ned -> Angle
-bearing v =
-    let a = atan2' (toMetres (east v)) (toMetres (north v))
-     in normalise a (decimalDegrees 360.0)
-
--- | @elevation v@ computes the elevation of the NED vector @v@ from horizontal (ie tangent to ellipsoid surface).
-elevation :: Ned -> Angle
-elevation (Ned v) = negate' (asin' (vz v / vnorm v))
-
--- | @slantRange v@ computes the distance from origin in the local system of the NED vector @v@.
-slantRange :: Ned -> Length
-slantRange (Ned v) = metres (vnorm v)
-
--- | @deltaBetween p1 p2 f e@ computes the exact 'Delta' between the two positions @p1@ and @p2@ in frame @f@
--- using earth model @e@.
---
--- @
---     let p1 = decimalLatLongHeight 1 2 (metres (-3))
---     let p2 = decimalLatLongHeight 4 5 (metres (-6))
---     let w = decimalDegrees 5 -- wander azimuth
---     let d = deltaBetween p1 p2 (frameL w) wgs84
---     d = deltaMetres 359490.579 302818.523 17404.272
--- @
-deltaBetween :: (ETransform a, Frame c) => a -> a -> (a -> Earth -> c) -> Earth -> Delta
-deltaBetween p1 p2 f e = deltaMetres (vx d) (vy d) (vz d)
-  where
-    e1 = ecefvec p1 e
-    e2 = ecefvec p2 e
-    de = vsub e2 e1
-    -- rotation matrix to go from Earth Frame to Frame at p1
-    rm = transpose (rEF (f p1 e))
-    d = vrotate de rm
-
--- | @nedBetween p1 p2 e@ computes the exact 'Ned' vector between the two positions @p1@ and @p2@, in north, east, and down
--- using earth model @e@.
---
--- Produced 'Ned' delta is relative to @p1@: Due to the curvature of Earth and different directions to the North Pole,
--- the north, east, and down directions will change (relative to Earth) for different places.
---
--- Position @p1@ must be outside the poles for the north and east directions to be defined.
---
--- @
---     let p1 = decimalLatLongHeight 1 2 (metres (-3))
---     let p2 = decimalLatLongHeight 4 5 (metres (-6))
---     let d1 = nedBetween p1 p2 wgs84
---     let d2 = deltaBetween p1 p2 frameN wgs84
---     north d1 = dx d2
---     east d1 = dy d2
---     down d1 = dz d2
--- @
-nedBetween :: (ETransform a) => a -> a -> Earth -> Ned
-nedBetween p1 p2 e = nedMetres (vx d) (vy d) (vz d)
-  where
-    (Delta d) = deltaBetween p1 p2 frameN e
-
--- | @target p0 f d e@ computes the target position from position @p0@ and delta @d@ using in frame @f@
--- and using earth model @e@.
---
--- @
---     let p0 = decimalLatLongHeight 49.66618 3.45063 zero
---     let y = decimalDegrees 10 -- yaw
---     let r = decimalDegrees 20 -- roll
---     let p = decimalDegrees 30 -- pitch
---     let d = deltaMetres 3000 2000 100
---     target p0 (frameB y r p) d wgs84 = decimalLatLongHeight 49.6918016 3.4812669 (metres 6.007)
--- @
-target :: (ETransform a, Frame c) => a -> (a -> Earth -> c) -> Delta -> Earth -> a
-target p0 f (Delta d) e = fromEcef (ecefMetres (vx e0 + vx c) (vy e0 + vy c) (vz e0 + vz c)) e
-  where
-    e0 = ecefvec p0 e
-    rm = rEF (f p0 e)
-    c = vrotate d rm
-
--- | @targetN p0 d e@ computes the target position from position @p0@ and north, east, down @d@ using earth model @e@.
---
--- @
---     let p0 = decimalLatLongHeight 49.66618 3.45063 zero
---     targetN p0 (nedMeters 100 200 300) wgs84 = target p0 frameN (deltaMetres 100 200 300) wgs84
--- @
-targetN :: (ETransform a) => a -> Ned -> Earth -> a
-targetN p0 (Ned d) = target p0 frameN (Delta d)
-
--- | ECEF position (as a 'Vector3d') from given position.
-ecefvec :: (ETransform a) => a -> Earth -> Vector3d
-ecefvec p m = vec (toEcef p m)
-
--- | NVector (as a 'Vector3d') from given positon.
-nvec :: (ETransform a) => a -> Earth -> Vector3d
-nvec p e = vec (pos (ecefToNVector (toEcef p e) e))
+ src/Data/Geo/Jord/Geodesic.hs view
@@ -0,0 +1,372 @@+-- |
+-- Module:      Data.Geo.Jord.Geodesic
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Solutions to the direct and inverse geodesic problems on ellipsoidal models using Vincenty formulaes.
+-- A geodesic is the shortest path between two points on a curved surface - here an ellispoid. Using these
+-- functions improves on the accuracy available using "Data.Geo.Jord.GreatCircle" at the expense of higher
+-- CPU usage.
+--
+-- In order to use this module you should start with the following imports:
+--
+-- @
+--     import Data.Geo.Jord.Geodesic
+--     import Data.Geo.Jord.Position
+-- @
+--
+-- If you wish to use both this module and the "Data.Geo.Jord.GreatCircle" module you must qualify both imports.
+--
+-- <http://www.ngs.noaa.gov/PUBS_LIB/inverse.pdf T Vincenty, "Direct and Inverse Solutions of Geodesics on the Ellipsoid with application of nested equations", Survey Review, vol XXIII no 176, 1975.>
+--
+module Data.Geo.Jord.Geodesic
+    (
+    -- * The 'Geodesic' type
+      Geodesic
+    , geodesicPos1
+    , geodesicPos2
+    , geodesicBearing1
+    , geodesicBearing2
+    , geodesicLength
+    -- * Calculations
+    , directGeodesic
+    , inverseGeodesic
+    , destination
+    , finalBearing
+    , initialBearing
+    , surfaceDistance
+    ) where
+
+import Data.Geo.Jord.Internal
+import Data.Geo.Jord.Position
+
+-- | Geodesic line: shortest route between two positions on the surface of a model.
+data Geodesic a =
+    Geodesic
+        { geodesicPos1 :: Position a -- ^ geodesic start position, p1.
+        , geodesicPos2 :: Position a -- ^ geodesic end position, p2.
+        , geodesicBearing1 :: Maybe Angle -- ^ initial bearing from p1 to p2, if p1 and p2 are different.
+        , geodesicBearing2 :: Maybe Angle -- ^ final bearing from p1 to p2, if p1 and p2 are different
+        , geodesicLength :: Length -- ^ length of the geodesic: the surface distance between p1 and p2.
+        }
+    deriving (Eq, Show)
+
+-- | @directGeodesic p1 b1 d@ solves the direct geodesic problem using Vicenty formula: position
+-- along the geodesic, reached from position @p1@ having travelled the __surface__ distance @d@ on
+-- the initial bearing (compass angle) @b1@ at __constant__ height; it also returns the final bearing
+-- at the reached position.
+-- The Vincenty formula for the direct problem should always converge, however this function returns
+-- 'Nothing' if it would ever fail to do so (probably thus indicating a bug in the implementation).
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> directGeodesic (northPole WGS84) zero (kilometres 20003.931458623)
+-- Just (Geodesic {geodesicPos1 = 90°0'0.000"N,0°0'0.000"E 0.0m (WGS84)
+--               , geodesicPos2 = 90°0'0.000"S,180°0'0.000"E 0.0m (WGS84)
+--               , geodesicBearing1 = Just 0°0'0.000"
+--               , geodesicBearing2 = Just 180°0'0.000"
+--               , geodesicLength = 20003.931458623km})
+--
+directGeodesic :: (Ellipsoidal a) => Position a -> Angle -> Length -> Maybe (Geodesic a)
+directGeodesic p1 b1 d
+    | d == zero = Just (Geodesic p1 p1 (Just b1) (Just b1) zero)
+    | otherwise =
+        case rec of
+            Nothing -> Nothing
+            (Just (s, cosS, sinS, cos2S')) -> Just (Geodesic p1 p2 (Just b1) (Just b2) d)
+                where x = sinU1 * sinS - cosU1 * cosS * cosAlpha1
+                      lat2 =
+                          atan2
+                              (sinU1 * cosS + cosU1 * sinS * cosAlpha1)
+                              ((1.0 - f) * sqrt (sinAlpha * sinAlpha + x * x))
+                      lambda = atan2 (sinS * sinAlpha1) (cosU1 * cosS - sinU1 * sinS * cosAlpha1)
+                      _C = f / 16.0 * cosSqAlpha * (4.0 + f * (4.0 - 3.0 * cosSqAlpha))
+                      _L =
+                          lambda -
+                          (1.0 - _C) * f * sinAlpha *
+                          (s + _C * sinS * (cos2S' + _C * cosS * (-1.0 + 2.0 * cos2S' * cos2S')))
+                      lon2 = lon1 + _L
+                      b2 = normalise (radians (atan2 sinAlpha (-x))) (decimalDegrees 360.0)
+                      p2 = latLongHeightPos' (radians lat2) (radians lon2) (height p1) (model p1)
+  where
+    lat1 = toRadians . latitude $ p1
+    lon1 = toRadians . longitude $ p1
+    ell = surface . model $ p1
+    (a, b, f) = abf ell
+    br1 = toRadians b1
+    cosAlpha1 = cos br1
+    sinAlpha1 = sin br1
+    (tanU1, cosU1, sinU1) = reducedLat lat1 f
+    sigma1 = atan2 tanU1 cosAlpha1 -- angular distance on the sphere from the equator to p1
+    sinAlpha = cosU1 * sinAlpha1 -- alpha = azimuth of the geodesic at the equator
+    cosSqAlpha = 1.0 - sinAlpha * sinAlpha
+    uSq = cosSqAlpha * (a * a - b * b) / (b * b)
+    _A = 1.0 + uSq / 16384.0 * (4096.0 + uSq * (-768.0 + uSq * (320.0 - 175.0 * uSq)))
+    _B = uSq / 1024.0 * (256.0 + uSq * (-128.0 + uSq * (74.0 - 47.0 * uSq)))
+    dm = toMetres d
+    sigma = dm / (b * _A)
+    rec = directRec sigma1 dm _A _B b sigma 0
+
+-- | @inverseGeodesic p1 p2@ solves the inverse geodesic problem using Vicenty formula: __surface__ distance,
+-- and initial/final bearing between the geodesic line between positions @p1@ and @p2@.
+-- The Vincenty formula for the inverse problem can fail to converge for nearly antipodal points in which
+-- case this function returns 'Nothing'.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> inverseGeodesic (latLongPos 0 0 WGS84) (latLongPos 0.5 179.5 WGS84)
+-- Just (Geodesic {geodesicPos1 = 0°0'0.000"N,0°0'0.000"E 0.0m (WGS84)
+--               , geodesicPos2 = 0°30'0.000"N,179°30'0.000"E 0.0m (WGS84)
+--               , geodesicBearing1 = Just 25°40'18.742"
+--               , geodesicBearing2 = Just 154°19'37.507"
+--               , geodesicLength = 19936.288578981km})
+-- >>>
+-- >>> inverseGeodesic (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84)
+-- Nothing
+--
+inverseGeodesic :: (Ellipsoidal a) => Position a -> Position a -> Maybe (Geodesic a)
+inverseGeodesic p1 p2
+    | llEq p1 p2 = Just (Geodesic p1 p2 Nothing Nothing zero)
+    | otherwise =
+        case rec of
+            Nothing -> Nothing
+            (Just (cosL, sinL, s, cosS, sinS, sinSqS, cos2S', cosSqA)) ->
+                Just (Geodesic p1 p2 (Just b1) (Just b2) d)
+                where uSq = cosSqA * (a * a - b * b) / (b * b)
+                      _A =
+                          1 +
+                          uSq / 16384.0 * (4096.0 + uSq * (-768.0 + uSq * (320.0 - 175.0 * uSq)))
+                      _B = uSq / 1024.0 * (256.0 + uSq * (-128.0 + uSq * (74.0 - 47.0 * uSq)))
+                      deltaSigma =
+                          _B * sinS *
+                          (cos2S' +
+                           _B / 4.0 *
+                           (cosS * (-1.0 + 2.0 * cos2S' * cos2S') -
+                            _B / 6.0 * cos2S' * (-3.0 + 4.0 * sinS * sinS) *
+                            (-3.0 + 4.0 * cos2S' * cos2S')))
+                      d = metres (b * _A * (s - deltaSigma))
+                      a1R =
+                          if abs sinSqS < epsilon
+                              then 0.0
+                              else atan2 (cosU2 * sinL) (cosU1 * sinU2 - sinU1 * cosU2 * cosL)
+                      a2R =
+                          if abs sinSqS < epsilon
+                              then pi
+                              else atan2 (cosU1 * sinL) (-sinU1 * cosU2 + cosU1 * sinU2 * cosL)
+                      b1 = normalise (radians a1R) (decimalDegrees 360.0)
+                      b2 = normalise (radians a2R) (decimalDegrees 360.0)
+  where
+    lat1 = toRadians . latitude $ p1
+    lon1 = toRadians . longitude $ p1
+    lat2 = toRadians . latitude $ p2
+    lon2 = toRadians . longitude $ p2
+    ell = surface . model $ p1
+    (a, b, f) = abf ell
+    _L = lon2 - lon1 -- difference in longitude
+    (_, cosU1, sinU1) = reducedLat lat1 f
+    (_, cosU2, sinU2) = reducedLat lat2 f
+    antipodal = abs _L > pi / 2.0 || abs (lat2 - lat1) > pi / 2.0
+    rec = inverseRec _L cosU1 sinU1 cosU2 sinU2 _L f antipodal 0
+
+-- | @finalBearing p1 p2@ computes the final bearing arriving at @p2@ from @p1@ in compass angle.
+-- Compass angles are clockwise angles from true north: 0° = north, 90° = east, 180° = south, 270° = west.
+-- The final bearing will differ from the initial bearing by varying degrees according to distance and latitude.
+-- Returns 'Nothing' if both positions are equals or if 'inverseGeodesic' fails to converge.
+--
+-- This is equivalent to:
+--
+-- @
+--     ('inverseGeodesic' p1 p2) >>= 'geodesicBearing2'
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> p1 = latLongPos (-37.95103341666667) 144.42486788888888 WGS84
+-- >>> p2 = latLongPos (-37.65282113888889) 143.92649552777777 WGS84
+-- >>> initialBearing p1 p2
+-- Just 307°10'25.070"
+--
+finalBearing :: (Ellipsoidal a) => Position a -> Position a -> Maybe Angle
+finalBearing p1 p2 = inverseGeodesic p1 p2 >>= geodesicBearing2
+
+-- | @initialBearing p1 p2@ computes the initial bearing from @p1@ to @p2@ in compass angle.
+-- Compass angles are clockwise angles from true north: 0° = north, 90° = east, 180° = south, 270° = west.
+-- Returns 'Nothing' if both positions are equals or if 'inverseGeodesic' fails to converge.
+--
+-- @
+--     ('inverseGeodesic' p1 p2) >>= 'geodesicBearing1'
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> p1 = latLongPos (-37.95103341666667) 144.42486788888888 WGS84
+-- >>> p2 = latLongPos (-37.65282113888889) 143.92649552777777 WGS84
+-- >>> initialBearing p1 p2
+-- Just 306°52'5.373"
+--
+initialBearing :: (Ellipsoidal a) => Position a -> Position a -> Maybe Angle
+initialBearing p1 p2 = inverseGeodesic p1 p2 >>= geodesicBearing1
+
+-- | @surfaceDistance p1 p2@ computes the surface distance on the geodesic between the
+-- positions @p1@ and @p2@.
+-- This function relies on 'inverseGeodesic' and can therefore fail to compute the distance
+-- for nearly antipodal positions.
+--
+-- @
+--     fmap 'geodesicLength' ('inverseGeodesic' p1 p2)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> surfaceDistance (northPole WGS84) (southPole WGS84)
+-- Just 20003.931458623km
+--
+surfaceDistance :: (Ellipsoidal a) => Position a -> Position a -> Maybe Length
+surfaceDistance p1 p2 = fmap geodesicLength (inverseGeodesic p1 p2)
+
+-- | @destination p b d@ computes the position along the geodesic, reached from
+-- position @p@ having travelled the __surface__ distance @d@ on the initial bearing (compass angle) @b@
+-- at __constant__ height.
+-- Note that the  bearing will normally vary before destination is reached.
+--
+-- @
+--     fmap 'geodesicPos2' ('directGeodesic' p b d)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Geodesic
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> destination (wgs84Pos 54 154 (metres 15000)) (decimalDegrees 33) (kilometres 1000)
+-- Just 61°10'8.983"N,164°7'52.258"E 15.0km (WGS84)
+--
+destination :: (Ellipsoidal a) => Position a -> Angle -> Length -> Maybe (Position a)
+destination p b d = fmap geodesicPos2 (directGeodesic p b d)
+
+directRec ::
+       Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Int
+    -> Maybe (Double, Double, Double, Double)
+directRec sigma1 dist _A _B b sigma i
+    | i == 100 = Nothing
+    | abs (sigma - newSigma) <= 1e-12 = Just (newSigma, cosSigma, sinSigma, cos2Sigma')
+    | otherwise = directRec sigma1 dist _A _B b newSigma (i + 1)
+  where
+    cos2Sigma' = cos (2 * sigma1 + sigma)
+    sinSigma = sin sigma
+    cosSigma = cos sigma
+    deltaSigma =
+        _B * sinSigma *
+        (cos2Sigma' +
+         _B / 4.0 *
+         (cosSigma * (-1.0 + 2.0 * cos2Sigma' * cos2Sigma') -
+          _B / 6.0 * cos2Sigma' * (-3.0 + 4.0 * sinSigma * sinSigma) *
+          (-3.0 + 4.0 * cos2Sigma' * cos2Sigma')))
+    newSigma = dist / (b * _A) + deltaSigma
+
+inverseRec ::
+       Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Bool
+    -> Int
+    -> Maybe (Double, Double, Double, Double, Double, Double, Double, Double)
+inverseRec lambda cosU1 sinU1 cosU2 sinU2 _L f antipodal i
+    | i == 1000 = Nothing
+    -- co-incident/antipodal points (falls back on λ/σ = L)
+    | sinSqSigma < epsilon = Just (inverseFallback cosL sinL sinSqSigma antipodal)
+    | iterationCheck > pi = Nothing
+    | abs (lambda - newLambda) <= 1e-12 =
+        Just (cosL, sinL, sigma, cosSigma, sinSigma, sinSqSigma, cos2Sigma', cosSqAlpha)
+    | otherwise = inverseRec newLambda cosU1 sinU1 cosU2 sinU2 _L f antipodal (i + 1)
+  where
+    sinL = sin lambda
+    cosL = cos lambda
+    sinSqSigma =
+        (cosU2 * sinL) * (cosU2 * sinL) +
+        (cosU1 * sinU2 - sinU1 * cosU2 * cosL) * (cosU1 * sinU2 - sinU1 * cosU2 * cosL)
+    sinSigma = sqrt sinSqSigma
+    cosSigma = sinU1 * sinU2 + cosU1 * cosU2 * cosL
+    sigma = atan2 sinSigma cosSigma
+    sinAlpha = cosU1 * cosU2 * sinL / sinSigma
+    cosSqAlpha = 1 - sinAlpha * sinAlpha
+    cos2Sigma' =
+        if cosSqAlpha /= 0
+            then cosSigma - 2.0 * sinU1 * sinU2 / cosSqAlpha
+            else 0
+    _C = f / 16.0 * cosSqAlpha * (4.0 + f * (4.0 - 3.0 * cosSqAlpha))
+    newLambda =
+        _L +
+        (1.0 - _C) * f * sinAlpha *
+        (sigma +
+         _C * sinSigma * (cos2Sigma' + _C * cosSigma * (-1.0 + 2.0 * cos2Sigma' * cos2Sigma')))
+    iterationCheck =
+        if antipodal
+            then abs newLambda - pi
+            else abs newLambda
+
+inverseFallback ::
+       Double
+    -> Double
+    -> Double
+    -> Bool
+    -> (Double, Double, Double, Double, Double, Double, Double, Double)
+inverseFallback cosL sinL sinSqSigma antipodal =
+    (cosL, sinL, sigma, cosSigma, sinSigma, sinSqSigma, cos2Sigma', cosSqAlpha)
+  where
+    sigma =
+        if antipodal
+            then pi
+            else 0
+    cosSigma =
+        if antipodal
+            then (-1)
+            else 1
+    sinSigma = 0
+    cos2Sigma' = 1
+    cosSqAlpha = 1
+
+-- | see Numeric.Limits
+epsilon :: Double
+epsilon = r
+  where
+    r = 1 - encodeFloat (m - 1) e
+    (m, e) = decodeFloat (1 :: Double)
+
+reducedLat :: Double -> Double -> (Double, Double, Double)
+reducedLat lat f = (tanU, cosU, sinU)
+  where
+    tanU = (1.0 - f) * tan lat
+    cosU = 1.0 / sqrt (1 + tanU * tanU)
+    sinU = tanU * cosU
+
+abf :: Ellipsoid -> (Double, Double, Double)
+abf e = (toMetres . equatorialRadius $ e, toMetres . polarRadius $ e, flattening e)
− src/Data/Geo/Jord/Geodetics.hs 
@@ -1,462 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}---- |
--- Module:      Data.Geo.Jord.Geodetics
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Geodetic calculations assuming a __spherical__ earth model.
---
--- All functions are implemented using the vector-based approached described in
--- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
---
-module Data.Geo.Jord.Geodetics-    (-    -- * The 'GreatCircle' type-      GreatCircle-    , IsGreatCircle(..)-    , gcPos-    , gcBearing-    -- * The 'GreatArc' type-    , GreatArc-    , IsGreatArc(..)-    , gaStart-    , gaEnd-    -- * Calculations
-    , alongTrackDistance-    , alongTrackDistance84-    , angularDistance-    , antipode-    , crossTrackDistance-    , crossTrackDistance84-    , destination-    , destination84-    , finalBearing-    , initialBearing-    , interpolate-    , intersection-    , intersections-    , isBetween-    , isInsideSurface-    , mean-    , surfaceDistance-    , surfaceDistance84-    ) where--import Control.Monad.Fail-import Data.Fixed-import Data.Geo.Jord.Angle-import Data.Geo.Jord.AngularPosition-import Data.Geo.Jord.Earth (r84)-import Data.Geo.Jord.Internal (nvec, sad)-import Data.Geo.Jord.Length-import Data.Geo.Jord.NVector-import Data.Geo.Jord.Quantity-import Data.Geo.Jord.Transformation-import Data.Geo.Jord.Vector3d-import Data.List (subsequences)-import Data.Maybe (fromJust, fromMaybe, isNothing)-import Prelude hiding (fail)---- | A circle on the __surface__ of the Earth which lies in a plane passing through
--- the Earth's centre. Every two distinct and non-antipodal points on the surface
--- of the Earth define a Great Circle.
---
--- It is internally represented as its normal vector - i.e. the normal vector
--- to the plane containing the great circle.
---
--- see 'IsGreatCircle'.
-data GreatCircle = GreatCircle-    { gcNormal :: Vector3d -- ^ normal vector to the plane containing the great circle-    , gcPos :: NVector -- ^ position (/n/-vector) on the great circle-    , gcBearing :: Angle -- ^ bearing from 'gcPos'.-    } deriving (Eq, Show)---- | Class for data from which a 'GreatCircle' can be computed.
-class IsGreatCircle a where-    greatCircle :: a -> GreatCircle -- ^ 'GreatCircle' from @a@, if 'greateCircleE' returns a 'Left', this function 'error's.
-    greatCircle a = fromMaybe (error "Could not make a Great Circle") (greatCircleF a)-    greatCircleE :: a -> Either String GreatCircle -- ^ 'GreatCircle' from @a@, A 'Left' indicates an error.
-    greatCircleF :: (MonadFail m) => a -> m GreatCircle -- ^ 'GreatCircle' from @a@, if 'greateCircleE' returns a 'Left', this function 'fail's.
-    greatCircleF a =-        case e of-            Left err -> fail err-            Right gc -> return gc-      where-        e = greatCircleE a---- | A closed segment of 'GreatCircle'. It represent the shortest path on the __surface__ of the Earth--- between the two positions.------ see 'IsGreatArc'.-data GreatArc = GreatArc-    { gaNormal :: Vector3d -- ^ normal vector to the plane containing the great circle-    , gaStart :: NVector -- ^ start position (/n/-vector) of the great arc-    , gaEnd :: NVector -- ^ end position (/n/-vector) of the great arc-    } deriving (Eq, Show)---- | Class for data from which a 'GreatArc' can be computed.-class IsGreatArc a where-    greatArc :: a -> GreatArc -- ^ 'GreatCircle' from @a@, if 'greatArcE' returns a 'Left', this function 'error's.-    greatArc a = fromMaybe (error "Could not make a Great Arc") (greatArcF a)-    greatArcE :: a -> Either String GreatArc -- ^ 'GreatArc' from @a@, A 'Left' indicates an error.-    greatArcF :: (MonadFail m) => a -> m GreatArc -- ^ 'GreatArc' from @a@, if 'greatArcE' returns a 'Left', this function 'fail's.-    greatArcF a =-        case e of-            Left err -> fail err-            Right ga -> return ga-      where-        e = greatArcE a---- | 'GreatCircle' passing by both given positions'. A 'Left' indicates that given positions are
--- equal or antipodal.
---
--- @
---     let p1 = decimalLatLongHeight 45.0 (-143.5) (metres 1500)
---     let p2 = decimalLatLongHeight 46.0 14.5 (metres 3000)
---     greatCircle (p1, p2) -- heights are ignored, great circle are always at earth surface.
--- @
-instance NTransform a => IsGreatCircle (a, a) where-    greatCircleE (p1, p2)-        | v1 == v2 = Left "Invalid Great Circle: positions are equal"-        | (realToFrac (vnorm (vadd v1 v2)) :: Nano) == 0 =-            Left "Invalid Great Circle: positions are antipodal"-        | isNothing b = Left "Invalid Great Circle: positions are equal"-        | otherwise = Right (GreatCircle (vcross v1 v2) nv1 (fromJust b))-      where-        nv1 = pos . toNVector $ p1-        v1 = vec nv1-        nv2 = pos . toNVector $ p2-        v2 = vec nv2-        b = initialBearing nv1 nv2---- | 'GreatCircle' passing by the given position and heading on given bearing.
---
--- @
---     greatCircle (readLatLong "283321N0290700W", decimalDegrees 33.0)
--- @
-instance NTransform a => IsGreatCircle (a, Angle) where-    greatCircleE (p, b) = Right (GreatCircle (vsub n' e') nv b)-      where-        nv = pos . toNVector $ p-        v = nvec nv-        e = vcross (vec northPole) v -- easting
-        n = vcross v e -- northing
-        e' = vscale e (cos' b / vnorm e)-        n' = vscale n (sin' b / vnorm n)---- | 'GreatCircle' from given 'GreatArc'.-instance IsGreatCircle GreatArc where-    greatCircleE (GreatArc n s e) =-        case initialBearing s e of-            Nothing -> Left "Could not computed initial bearing"-            (Just b) -> Right (GreatCircle n s b)---- | 'GreatArc' passing by both given positions'. A 'Left' indicates that given positions are--- equal or antipodal.------ @---     let p1 = decimalLatLongHeight 45.0 (-143.5) (metres 1500)---     let p2 = decimalLatLongHeight 46.0 14.5 (metres 3000)---     greatArc (p1, p2) -- heights are ignored, great arc are always at earth surface.--- @-instance NTransform a => IsGreatArc (a, a) where-    greatArcE ps@(p1, p2) =-        case greatCircleE ps of-            Left e -> Left e-            Right gcv ->-                Right (GreatArc (gcNormal gcv) (pos . toNVector $ p1) (pos . toNVector $ p2))---- | @alongTrackDistance p ga r@ how far position @p@ is along a path described--- by great arc @ga@: if a perpendicular is drawn from @p@  to the great arc, the--- along-track distance is the signed distance from the start point to where the--- perpendicular crosses the path.------ @---     let p = decimalLatLong 53.2611 (-0.7972)---     let ga = greatArc (decimalLatLong 53.3206 (-1.7297)) (decimalLatLong 53.1887 0.1334)---     alongTrackDistance p ga r84 -- 62.3315757 kilometres--- @-alongTrackDistance :: (NTransform a) => a -> GreatArc -> Length -> Length-alongTrackDistance p (GreatArc n s _) =-    arcLength (sad' (nvec s) (vcross (vcross n (nvec p)) n) (Just n))---- | 'alongTrackDistance' using the mean radius of the WGS84 reference ellipsoid.-alongTrackDistance84 :: (NTransform a) => a -> GreatArc -> Length-alongTrackDistance84 p ga = alongTrackDistance p ga r84---- | @angularDistance p1 p2 n@ computes the angle between the horizontal positions @p1@ and @p2@.
--- If @n@ is 'Nothing', the angle is always in [0..180], otherwise it is in [-180, +180],
--- signed + if @p1@ is clockwise looking along @n@, - in opposite direction.
-angularDistance :: (NTransform a) => a -> a -> Maybe a -> Angle-angularDistance p1 p2 n = sad' v1 v2 vn-  where-    v1 = nvec p1-    v2 = nvec p2-    vn = fmap nvec n---- | @antipode p@ computes the antipodal horizontal position of @p@:
--- the horizontal position on the surface of the Earth which is diametrically opposite to @p@.
-antipode :: (NTransform a) => a -> a-antipode p = fromNVector (angular (vscale (nvec nv) (-1.0)) h)-  where-    (AngularPosition nv h) = toNVector p---- | @crossTrackDistance p gc r@ computes the signed distance from horizontal position @p@ to great circle @gc@.
--- Returns a negative 'Length' if position if left of great circle,
--- positive 'Length' if position if right of great circle; the orientation of the
--- great circle is therefore important:
---
--- @
---     let gc1 = greatCircle (decimalLatLong 51 0) (decimalLatLong 52 1)
---     let gc2 = greatCircle (decimalLatLong 52 1) (decimalLatLong 51 0)
---     crossTrackDistance p gc1 r84 = (- crossTrackDistance p gc2 r84)
---
---     let p = decimalLatLong 53.2611 (-0.7972)
---     let gc = greatCircleBearing (decimalLatLong 53.3206 (-1.7297)) (decimalDegrees 96.0)
---     crossTrackDistance p gc r84 -- -305.663 metres
--- @
-crossTrackDistance :: (NTransform a) => a -> GreatCircle -> Length -> Length-crossTrackDistance p (GreatCircle n _ _) =-    arcLength (sub (sad' n (nvec p) Nothing) (decimalDegrees 90))---- | 'crossTrackDistance' using the mean radius of the WGS84 reference ellipsoid.
-crossTrackDistance84 :: (NTransform a) => a -> GreatCircle -> Length-crossTrackDistance84 p gc = crossTrackDistance p gc r84---- | @destination p b d r@ computes the destination position from position @p@ having
--- travelled the distance @d@ on the initial bearing (compass angle) @b@ (bearing will normally vary
--- before destination is reached) and using the earth radius @r@.
---
--- @
---     let p0 = ecefToNVector (ecefMetres 3812864.094 (-115142.863) 5121515.161) s84
---     let p1 = ecefMetres 3826406.4710518294 8900.536398998282 5112694.233184049
---     let p = destination p0 (decimalDegrees 96.0217) (metres 124800) r84
---     nvectorToEcef p s84 = p1
--- @
-destination :: (NTransform a) => a -> Angle -> Length -> Length -> a-destination p b d r-    | toMetres d == 0.0 = p-    | otherwise = fromNVector (angular vd h)-  where-    (AngularPosition nv h) = toNVector p-    v = vec nv-    ed = vunit (vcross (vec northPole) v) -- east direction vector at v
-    nd = vcross v ed -- north direction vector at v
-    ta = central d r -- central angle
-    de = vadd (vscale nd (cos' b)) (vscale ed (sin' b)) -- vunit vector in the direction of the azimuth
-    vd = vadd (vscale v (cos' ta)) (vscale de (sin' ta))---- | 'destination' using the mean radius of the WGS84 reference ellipsoid.
-destination84 :: (NTransform a) => a -> Angle -> Length -> a-destination84 p b d = destination p b d r84---- | @finalBearing p1 p2@ computes the final bearing arriving at @p2@ from @p1@ in compass angle.
---
--- Compass angles are clockwise angles from true north: 0 = north, 90 = east, 180 = south, 270 = west.
---
--- The final bearing will differ from the 'initialBearing' by varying degrees according to distance and latitude.
---
--- Returns 'Nothing' if both horizontal positions are equals.
-finalBearing :: (Eq a, NTransform a) => a -> a -> Maybe Angle-finalBearing p1 p2 = fmap (\b -> normalise b (decimalDegrees 180)) (initialBearing p2 p1)---- | @initialBearing p1 p2@ computes the initial bearing from @p1@ to @p2@ in compass angle.
---
--- Compass angles are clockwise angles from true north: 0 = north, 90 = east, 180 = south, 270 = west.
---
--- Returns 'Nothing' if both horizontal positions are equals.
-initialBearing :: (Eq a, NTransform a) => a -> a -> Maybe Angle-initialBearing p1 p2-    | p1 == p2 = Nothing-    | otherwise = Just (normalise (sad' gc1 gc2 (Just v1)) (decimalDegrees 360))-  where-    v1 = nvec p1-    v2 = nvec p2-    gc1 = vcross v1 v2 -- great circle through p1 & p2
-    gc2 = vcross v1 (vec northPole) -- great circle through p1 & north pole
---- | @interpolate p0 p1 f# computes the horizontal position at fraction @f@ between the @p0@ and @p1@.
---
--- Special conditions:
---
--- @
---     interpolate p0 p1 0.0 = p0
---     interpolate p0 p1 1.0 = p1
--- @
---
--- 'error's if @f < 0 || f > 1@
---
--- @
---     let p1 = latLongHeight (readLatLong "53°28'46''N 2°14'43''W") (metres 10000)
---     let p2 = latLongHeight (readLatLong "55°36'21''N 13°02'09''E") (metres 20000)
---     interpolate p1 p2 0.5 = decimalLatLongHeight 54.7835574 5.1949856 (metres 15000)
--- @
-interpolate :: (NTransform a) => a -> a -> Double -> a-interpolate p0 p1 f-    | f < 0 || f > 1 = error ("fraction must be in range [0..1], was " ++ show f)-    | f == 0 = p0-    | f == 1 = p1-    | otherwise = fromNVector (angular iv ih)-  where-    (AngularPosition nv0 h0) = toNVector p0-    (AngularPosition nv1 h1) = toNVector p1-    v0 = vec nv0-    v1 = vec nv1-    iv = vunit (vadd v0 (vscale (vsub v1 v0) f))-    ih = lrph h0 h1 f---- | Computes the intersection between the two given 'GreatArc's.------ see also 'intersections'------ @---     let spd = kilometresPerHour 1000---     let t1 = Track (decimalLatLong 51.885 0.235) (decimalDegrees 108.63) spd---     let t2 = Track (decimalLatLong 49.008 2.549) (decimalDegrees 32.72) spd---     let oneHour = hours 1---     let ga1 = greatArc (t1, oneHour)---     let ga2 = greatArc (t2, oneHour)---     intersection ga1 ga2 = Just (decimalLatLong 50.9017225 4.494278333333333)--- @-intersection :: (NTransform a) => GreatArc -> GreatArc -> Maybe a-intersection ga1@(GreatArc n1 _ _) ga2@(GreatArc n2 _ _) =-    case intersections' n1 n2 of-        Nothing -> Nothing-        (Just (i1, i2))-            | isBetween i1 ga1 && isBetween i1 ga2 -> Just i1-            | isBetween i2 ga1 && isBetween i2 ga2 -> Just i2-            | otherwise -> Nothing---- | Computes the intersections between the two given 'GreatCircle's.
--- Two 'GreatCircle's intersect exactly twice unless there are equal (regardless of orientation),
--- in which case 'Nothing' is returned.
---
--- @
---     let gc1 = greatCircleBearing (decimalLatLong 51.885 0.235) (decimalDegrees 108.63)
---     let gc2 = greatCircleBearing (decimalLatLong 49.008 2.549) (decimalDegrees 32.72)
---     let (i1, i2) = fromJust (intersections gc1 gc2)
---     i1 = decimalLatLong 50.9017226 4.4942782
---     i2 = antipode i1
--- @
-intersections :: (NTransform a) => GreatCircle -> GreatCircle -> Maybe (a, a)-intersections (GreatCircle n1 _ _) (GreatCircle n2 _ _) = intersections' n1 n2---- | @isBetween p ga@ determines whether position @p@ is between start and end points--- of great arc @ga@.--- If @p@ is not on the great arc, returns whether @p@ is within the area bound--- by perpendiculars to the great arc at each point (in the same hemisphere).----isBetween :: (NTransform a) => a -> GreatArc -> Bool-isBetween p (GreatArc _ s e) = between && hemisphere-  where-    v0 = nvec p-    v1 = nvec s-    v2 = nvec e-    v10 = vsub v0 v1-    v12 = vsub v2 v1-    v20 = vsub v0 v2-    v21 = vsub v1 v2-    e1 = vdot v10 v12 -- p is on e side of s-    e2 = vdot v20 v21 -- p is on s side of e-    between = e1 >= 0 && e2 >= 0-    hemisphere = vdot v0 v1 >= 0 && vdot v0 v2 >= 0---- | @isInsideSurface p ps@ determines whether the @p@ is inside the polygon defined by the list of positions @ps@.--- The polygon is closed if needed (i.e. if @head ps /= last ps@).------ Uses the angle summation test: on a sphere, due to spherical excess, enclosed point angles--- will sum to less than 360°, and exterior point angles will be small but non-zero.------ Always returns 'False' if @ps@ does not at least defines a triangle.------ @---     let malmo = decimalLatLong 55.6050 13.0038---     let ystad = decimalLatLong 55.4295 13.82---     let lund = decimalLatLong 55.7047 13.1910---     let helsingborg = decimalLatLong 56.0465 12.6945---     let kristianstad = decimalLatLong 56.0294 14.1567---     let polygon = [malmo, ystad, kristianstad, helsingborg, lund]---     let hoor = decimalLatLong 55.9295 13.5297---     let hassleholm = decimalLatLong 56.1589 13.7668---     isInsideSurface hoor polygon = True---     isInsideSurface hassleholm polygon = False--- @-isInsideSurface :: (Eq a, NTransform a) => a -> [a] -> Bool-isInsideSurface p ps-    | null ps = False-    | head ps == last ps = isInsideSurface p (init ps)-    | length ps < 3 = False-    | otherwise =-        let aSum =-                foldl-                    (\a v' -> add a (uncurry sad' v' (Just v)))-                    (decimalDegrees 0)-                    (egdes (map (vsub v) vs))-         in abs (toDecimalDegrees aSum) > 180.0-  where-    v = nvec p-    vs = fmap nvec ps---- | @mean ps@ computes the mean geographic horitzontal position of @ps@, if it is defined.
---
--- The geographic mean is not defined for antipodals position (since they
--- cancel each other).
---
--- Special conditions:
---
--- @
---     mean [] = Nothing
---     mean [p] = Just p
---     mean [p1, p2, p3] = Just circumcentre
---     mean [p1, .., antipode p1] = Nothing
--- @
-mean :: (NTransform a) => [a] -> Maybe a-mean [] = Nothing-mean [p] = Just p-mean ps =-    if null antipodals-        then Just (fromNVector (angular (vunit (foldl vadd vzero vs)) zero))-        else Nothing-  where-    vs = fmap nvec ps-    ts = filter (\l -> length l == 2) (subsequences vs)-    antipodals =-        filter (\t -> (realToFrac (vnorm (vadd (head t) (last t)) :: Double) :: Nano) == 0) ts---- | @surfaceDistance p1 p2@ computes the surface distance (length of geodesic) between the positions @p1@ and @p2@.
-surfaceDistance :: (NTransform a) => a -> a -> Length -> Length-surfaceDistance p1 p2 = arcLength (angularDistance p1 p2 Nothing)---- | 'surfaceDistance' using the mean radius of the WGS84 reference ellipsoid.
-surfaceDistance84 :: (NTransform a) => a -> a -> Length-surfaceDistance84 p1 p2 = surfaceDistance p1 p2 r84---- | Signed angular distance - see 'sad'.-sad' :: Vector3d -> Vector3d -> Maybe Vector3d -> Angle-sad' v1 v2 n = radians (sad v1 v2 n)---- | [p1, p2, p3, p4] to [(p1, p2), (p2, p3), (p3, p4), (p4, p1)]
-egdes :: [Vector3d] -> [(Vector3d, Vector3d)]-egdes ps = zip ps (tail ps ++ [head ps])--lrph :: Length -> Length -> Double -> Length-lrph h0 h1 f = metres h-  where-    h0' = toMetres h0-    h1' = toMetres h1-    h = h0' + (h1' - h0') * f--angular :: Vector3d -> Length -> AngularPosition NVector-angular v = nvectorHeight (nvector (vx v) (vy v) (vz v))--intersections' :: (NTransform a) => Vector3d -> Vector3d -> Maybe (a, a)-intersections' n1 n2-    | (vnorm i :: Double) == 0.0 = Nothing-    | otherwise-    , let ni = fromNVector (angular (vunit i) zero) = Just (ni, antipode ni)-  where-    i = vcross n1 n2
+ src/Data/Geo/Jord/GreatCircle.hs view
@@ -0,0 +1,527 @@+-- |
+-- Module:      Data.Geo.Jord.GreatCircle
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Geographical Position calculations on great circles, i.e. using a __sphere__ to represent
+-- the celestial body that positions refer to.
+--
+-- In order to use this module you should start with the following imports:
+--
+-- @
+--     import Data.Geo.Jord.GreatCircle
+--     import Data.Geo.Jord.Position
+-- @
+--
+-- If you wish to use both this module and the "Data.Geo.Jord.Geodesic" module you must qualify both imports.
+--
+-- All functions are implemented using the vector-based approached described in
+-- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Point_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
+--
+module Data.Geo.Jord.GreatCircle
+    (
+    -- * The 'GreatCircle' type
+      GreatCircle
+    , greatCircleThrough
+    , greatCircleHeadingOn
+    -- * The 'MinorArc' type
+    , MinorArc
+    , minorArc
+    -- * Calculations
+    , alongTrackDistance
+    , alongTrackDistance'
+    , angularDistance
+    , crossTrackDistance
+    , crossTrackDistance'
+    , destination
+    , finalBearing
+    , initialBearing
+    , interpolate
+    , intersection
+    , intersections
+    , isBetween
+    , isInsideSurface
+    , mean
+    , surfaceDistance
+    ) where
+
+import Data.Fixed (Nano)
+import Data.List (subsequences)
+
+import Data.Geo.Jord.Internal
+import Data.Geo.Jord.Position
+
+-- | A circle on the __surface__ of a __sphere__ which lies in a plane
+-- passing through the sphere centre. Every two distinct and non-antipodal points
+-- define a unique Great Circle.
+--
+-- It is internally represented as its normal vector - i.e. the normal vector
+-- to the plane containing the great circle.
+--
+data GreatCircle a =
+    GreatCircle !Vector3d !a String
+    deriving (Eq)
+
+instance (Model a) => Show (GreatCircle a) where
+    show (GreatCircle _ _ s) = s
+
+-- | @greatCircleThrough p1 p2@ returns the 'GreatCircle' passing by both positions @p1@ and @p2@.
+-- If positions are antipodal, any great circle passing through those positions will be returned.
+-- Returns 'Nothing' if given positions are equal.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = latLongHeightPos 45.0 (-143.5) (metres 1500) S84
+-- >>> let p2 = latLongHeightPos 46.0 14.5 (metres 3000) S84
+-- >>> greatCircleThrough p1 p2 -- heights are ignored, great circle is always at surface.
+-- Just Great Circle { through 45°0'0.000"N,143°30'0.000"W 1500.0m (S84) & 46°0'0.000"N,14°30'0.000"E 3000.0m (S84) }
+--
+greatCircleThrough :: (Spherical a) => Position a -> Position a -> Maybe (GreatCircle a)
+greatCircleThrough p1 p2
+    | llEq p1 p2 = Nothing
+    | otherwise = Just (GreatCircle (normal' p1 p2) (model p1) dscr)
+  where
+    dscr = "Great Circle { through " ++ show p1 ++ " & " ++ show p2 ++ " }"
+
+-- | @greatCircleHeadingOn p b@ returns the 'GreatCircle' passing by position @p@ and
+-- heading on bearing @b@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p = latLongPos 45.0 (-143.5) S84
+-- >>> let b = decimalDegrees 33.0
+-- >>> greatCircleHeadingOn p b
+-- Great Circle { by 45°0'0.000"N,143°30'0.000"W 0.0m (S84) & heading on 33°0'0.000" }
+--
+greatCircleHeadingOn :: (Spherical a) => Position a -> Angle -> GreatCircle a
+greatCircleHeadingOn p b = GreatCircle (vsub n' e') (model p) dscr
+  where
+    v = nvec p
+    e = vcross nvNorthPole v -- easting
+    n = vcross v e -- northing
+    e' = vscale e (cos' b / vnorm e)
+    n' = vscale n (sin' b / vnorm n)
+    dscr = "Great Circle { by " ++ show p ++ " & heading on " ++ show b ++ " }"
+
+-- | Oriented minor arc of a great circle between two positions: shortest path between
+-- positions on a great circle.
+data MinorArc a =
+    MinorArc !Vector3d (Position a) (Position a)
+    deriving (Eq)
+
+instance (Model a) => Show (MinorArc a) where
+    show (MinorArc _ s e) = "Minor Arc { from: " ++ show s ++ ", to: " ++ show e ++ " }"
+
+-- | @minorArc p1 p2@ returns the 'MinorArc' from @p1@ to @p2@.
+-- Returns 'Nothing' if given positions are equal.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = latLongHeightPos 45.0 (-143.5) (metres 1500) S84
+-- >>> let p2 = latLongHeightPos 46.0 14.5 (metres 3000) S84
+-- Just Minor Arc { from: 45°0'0.000"N,143°30'0.000"W 1500.0m (S84), to: 46°0'0.000"N,14°30'0.000"E 3000.0m (S84) }
+--
+minorArc :: (Spherical a) => Position a -> Position a -> Maybe (MinorArc a)
+minorArc p1 p2
+    | llEq p1 p2 = Nothing
+    | otherwise = Just (MinorArc (normal' p1 p2) p1 p2)
+
+-- | @alongTrackDistance p a@ computes how far Position @p@ is along a path described
+-- by the minor arc @a@: if a perpendicular is drawn from @p@  to the path, the
+-- along-track distance is the signed distance from the start point to where the
+-- perpendicular crosses the path.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p = s84Pos 53.2611 (-0.7972) zero
+-- >>> let g = minorArcBetween (s84Pos 53.3206 (-1.7297) zero) (s84Pos 53.1887 0.1334 zero)
+-- >>> fmap (alongTrackDistance p) a
+-- Right 62.3315757km
+--
+alongTrackDistance :: (Spherical a) => Position a -> MinorArc a -> Length
+alongTrackDistance p (MinorArc n s _) = alongTrackDistance'' p s n
+
+-- | @alongTrackDistance' p s b@ computes how far Position @p@ is along a path starting
+-- at @s@ and heading on bearing @b@: if a perpendicular is drawn from @p@  to the path, the
+-- along-track distance is the signed distance from the start point to where the
+-- perpendicular crosses the path.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p = s84Pos 53.2611 (-0.7972) zero
+-- >>> let s = s84Pos 53.3206 (-1.7297) zero
+-- >>> let b = decimalDegrees 96.0017325
+-- >>> alongTrackDistance' p s b
+-- 62.3315757km
+--
+alongTrackDistance' :: (Spherical a) => Position a -> Position a -> Angle -> Length
+alongTrackDistance' p s b = alongTrackDistance'' p s n
+  where
+    (GreatCircle n _ _) = greatCircleHeadingOn s b
+
+-- | @angularDistance p1 p2 n@ computes the angle between the horizontal Points @p1@ and @p2@.
+-- If @n@ is 'Nothing', the angle is always in [0..180], otherwise it is in [-180, +180],
+-- signed + if @p1@ is clockwise looking along @n@, - in opposite direction.
+angularDistance :: (Spherical a) => Position a -> Position a -> Maybe (Position a) -> Angle
+angularDistance p1 p2 n = signedAngle v1 v2 vn
+  where
+    v1 = nvec p1
+    v2 = nvec p2
+    vn = fmap nvec n
+
+-- | @crossTrackDistance p gc@ computes the signed distance from horizontal Position @p@ to great circle @gc@.
+-- Returns a negative 'Length' if Position if left of great circle,
+-- positive 'Length' if Position if right of great circle; the orientation of the
+-- great circle is therefore important:
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let gc1 = greatCircleThrough (s84Pos 51 0 zero) (s84Pos 52 1 zero)
+-- >>> fmap (crossTrackDistance p) gc1
+-- Right -176.7568725km
+-- >>>
+-- >>> let gc2 = greatCircleThrough (s84Pos 52 1 zero) (s84Pos 51 0 zero)
+-- >>> fmap (crossTrackDistance p) gc2
+-- Right 176.7568725km
+-- >>>
+-- >>> let p = s84Pos 53.2611 (-0.7972) zero
+-- >>> let gc = greatCircleHeadingOn (s84Pos 53.3206 (-1.7297) zero) (decimalDegrees 96.0)
+-- >>> crossTrackDistance p gc
+-- -305.6629 metres
+--
+crossTrackDistance :: (Spherical a) => Position a -> GreatCircle a -> Length
+crossTrackDistance p (GreatCircle n _ _) = arcLength (sub a (decimalDegrees 90)) (radius p)
+  where
+    a = radians (angleRadians n (nvec p))
+
+-- | @crossTrackDistance' p s b@ computes the signed distance from horizontal Position @p@ to the
+-- great circle passing by @s@ and heading on bearing @b@.
+--
+-- This is equivalent to:
+--
+-- @
+--     'crossTrackDistance' p ('greatCircleHeadingOn' s b)
+-- @
+--
+crossTrackDistance' :: (Spherical a) => Position a -> Position a -> Angle -> Length
+crossTrackDistance' p s b = crossTrackDistance p (greatCircleHeadingOn s b)
+
+-- | @destination p b d@ computes the position along the great circle, reached from
+-- position @p@ having travelled the __surface__ distance @d@ on the initial bearing (compass angle) @b@
+-- at __constant__ height.
+-- Note that the  bearing will normally vary before destination is reached.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> destination (s84Pos 54 154 (metres 15000)) (decimalDegrees 33) (kilometres 1000)
+-- 61°10'44.188"N,164°10'19.254"E 15.0km (S84)
+--
+destination :: (Spherical a) => Position a -> Angle -> Length -> Position a
+destination p b d
+    | d == zero = p
+    | otherwise = nvh nvd (height p) (model p)
+  where
+    nv = nvec p
+    ed = vunit (vcross nvNorthPole nv) -- east direction vector at v
+    nd = vcross nv ed -- north direction vector at v
+    r = radius p
+    ta = central d r -- central angle
+    de = vadd (vscale nd (cos' b)) (vscale ed (sin' b)) -- vunit vector in the direction of the azimuth
+    nvd = vadd (vscale nv (cos' ta)) (vscale de (sin' ta))
+
+-- | @surfaceDistance p1 p2@ computes the surface distance on the great circle between the
+-- positions @p1@ and @p2@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> surfaceDistance (northPole S84) (southPole S84)
+-- 20015.114352233km
+-- >>>
+-- >>> surfaceDistance (northPole S84) (northPole S84)
+-- 0.0m
+--
+surfaceDistance :: (Spherical a) => Position a -> Position a -> Length
+surfaceDistance p1 p2 = arcLength a (radius p1)
+  where
+    a = radians (angleRadians (nvec p1) (nvec p2))
+
+-- | @finalBearing p1 p2@ computes the final bearing arriving at @p2@ from @p1@ in compass angle.
+-- Compass angles are clockwise angles from true north: 0° = north, 90° = east, 180° = south, 270° = west.
+-- The final bearing will differ from the initial bearing by varying degrees according to distance and latitude.
+-- Returns 'Nothing' if both positions are equals.
+--
+-- ==== __Examples__
+--
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = s84Pos 0 1 (metres 12000)
+-- >>> let p2 = s84Pos 0 0 (metres 5000)
+-- >>> finalBearing p1 p2
+-- Just 270°0'0.000"
+-- >>>
+-- >>> finalBearing p1 p1
+-- Nothing
+--
+finalBearing :: (Spherical a) => Position a -> Position a -> Maybe Angle
+finalBearing p1 p2
+    | llEq p1 p2 = Nothing
+    | otherwise = Just (normalise (initialBearing' p2 p1) (decimalDegrees 180))
+
+-- | @initialBearing p1 p2@ computes the initial bearing from @p1@ to @p2@ in compass angle.
+-- Compass angles are clockwise angles from true north: 0° = north, 90° = east, 180° = south, 270° = west.
+-- Returns 'Nothing' if both positions are equals.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = s84Pos 58.643889 (-5.714722) (metres 12000)
+-- >>> let p2 = s84Pos 50.066389 (-5.714722) (metres 12000)
+-- >>> initialBearing p1 p2
+-- Just 180°0'0.000"
+-- >>>
+-- >>> initialBearing p1 p1
+-- Nothing
+--
+initialBearing :: (Spherical a) => Position a -> Position a -> Maybe Angle
+initialBearing p1 p2
+    | llEq p1 p2 = Nothing
+    | otherwise = Just (initialBearing' p1 p2)
+
+-- | @interpolate p0 p1 f# computes the position at fraction @f@ between the @p0@ and @p1@.
+--
+-- Special conditions:
+--
+-- @
+--     interpolate p0 p1 0.0 = p0
+--     interpolate p0 p1 1.0 = p1
+-- @
+--
+-- 'error's if @f < 0 || f > 1@
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = s84Pos 53.479444 (-2.245278) (metres 10000)
+-- >>> let p2 = s84Pos 55.605833 13.035833 (metres 20000)
+-- >>> interpolate p1 p2 0.5
+-- 54°47'0.805"N,5°11'41.947"E 15.0km (S84)
+--
+interpolate :: (Spherical a) => Position a -> Position a -> Double -> Position a
+interpolate p0 p1 f
+    | f < 0 || f > 1 = error ("fraction must be in range [0..1], was " ++ show f)
+    | f == 0 = p0
+    | f == 1 = p1
+    | otherwise = nvh iv ih (model p0)
+  where
+    nv0 = nvec p0
+    h0 = height p0
+    nv1 = nvec p1
+    h1 = height p1
+    iv = vunit (vadd nv0 (vscale (vsub nv1 nv0) f))
+    ih = lrph h0 h1 f
+
+-- | Computes the intersection between the two given minor arcs of great circle.
+--
+-- see also 'intersections'
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let a1 = minorArcBetween (s84Pos 51.885 0.235 zero) (s84Pos 48.269 13.093 zero)
+-- >>> let a2 = minorArcBetween (s84Pos 49.008 2.549 zero) (s84Pos 56.283 11.304 zero)
+-- >>> join (intersection <$> a1 <*> a2)
+-- Just 50°54'6.260"N,4°29'39.052"E 0.0m (S84)
+--
+intersection :: (Spherical a) => MinorArc a -> MinorArc a -> Maybe (Position a)
+intersection a1@(MinorArc n1 s1 _) a2@(MinorArc n2 _ _) =
+    case intersections' n1 n2 (model s1) of
+        Nothing -> Nothing
+        (Just (i1, i2))
+            | isBetween i1 a1 && isBetween i1 a2 -> Just i1
+            | isBetween i2 a1 && isBetween i2 a2 -> Just i2
+            | otherwise -> Nothing
+
+-- | Computes the intersections between the two given 'GreatCircle's.
+-- Two great circles intersect exactly twice unless there are equal (regardless of orientation),
+-- in which case 'Nothing' is returned.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let gc1 = greatCircleHeadingOn (s84Pos 51.885 0.235 zero) (decimalDegrees 108.63)
+-- >>> let gc2 = greatCircleHeadingOn (s84Pos 49.008 2.549 zero) (decimalDegrees 32.72)
+-- >>> intersections gc1 gc2
+-- Just (50°54'6.201"N,4°29'39.402"E 0.0m (S84),50°54'6.201"S,175°30'20.598"W 0.0m (S84))
+-- >>> let i = intersections gc1 gc2
+-- fmap fst i == fmap (antipode . snd) i
+-- >>> True
+--
+intersections :: (Spherical a) => GreatCircle a -> GreatCircle a -> Maybe (Position a, Position a)
+intersections (GreatCircle n1 m _) (GreatCircle n2 _ _) = intersections' n1 n2 m
+
+-- | @isBetween p a@ determines whether position @p@ is within the minor arc
+-- of great circle @a@.
+--
+-- If @p@ is not on the arc, returns whether @p@ is within the area bound
+-- by perpendiculars to the arc at each point (in the same hemisphere).
+--
+isBetween :: (Spherical a) => Position a -> MinorArc a -> Bool
+isBetween p (MinorArc _ s e) = between && hemisphere
+  where
+    v0 = nvec p
+    v1 = nvec s
+    v2 = nvec e
+    v10 = vsub v0 v1
+    v12 = vsub v2 v1
+    v20 = vsub v0 v2
+    v21 = vsub v1 v2
+    e1 = vdot v10 v12 -- p is on e side of s
+    e2 = vdot v20 v21 -- p is on s side of e
+    between = e1 >= 0 && e2 >= 0
+    hemisphere = vdot v0 v1 >= 0 && vdot v0 v2 >= 0
+
+-- | @isInsideSurface p ps@ determines whether position @p@ is inside the __surface__ polygon defined by
+-- positions @ps@ (i.e. ignoring the height of the positions).
+-- The polygon can be opened or closed (i.e. if @head ps /= last ps@).
+--
+-- Uses the angle summation test: on a sphere, due to spherical excess, enclosed point angles
+-- will sum to less than 360°, and exterior point angles will be small but non-zero.
+--
+-- Always returns 'False' if @ps@ does not at least defines a triangle.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.GreatCircle
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let malmo = s84Pos 55.6050 13.0038 zero
+-- >>> let ystad = s84Pos 55.4295 13.82 zero
+-- >>> let lund = s84Pos 55.7047 13.1910 zero
+-- >>> let helsingborg = s84Pos 56.0465 12.6945 zero
+-- >>> let kristianstad = s84Pos 56.0294 14.1567 zero
+-- >>> let polygon = [malmo, ystad, kristianstad, helsingborg, lund]
+-- >>> let hoor = s84Pos 55.9295 13.5297 zero
+-- >>> let hassleholm = s84Pos 56.1589 13.7668 zero
+-- >>> isInsideSurface hoor polygon
+-- True
+-- >>> isInsideSurface hassleholm polygon
+-- False
+--
+isInsideSurface :: (Spherical a) => Position a -> [Position a] -> Bool
+isInsideSurface p ps
+    | null ps = False
+    | llEq (head ps) (last ps) = isInsideSurface p (init ps)
+    | length ps < 3 = False
+    | otherwise =
+        let aSum = foldl (\a v' -> add a (uncurry signedAngle v' (Just v))) (decimalDegrees 0) (egdes (map (vsub v) vs))
+         in abs (toDecimalDegrees aSum) > 180.0
+  where
+    v = nvec p
+    vs = fmap nvec ps
+
+-- | @mean ps@ computes the geographic mean surface position of @ps@, if it is defined.
+--
+-- The geographic mean is not defined for antipodals positions (since they
+-- cancel each other).
+--
+-- Special conditions:
+--
+-- @
+--     mean [] = Nothing
+--     mean [p] = Just p
+--     mean [p1, p2, p3] = Just circumcentre
+--     mean [p1, .., antipode p1] = Nothing
+-- @
+mean :: (Spherical a) => [Position a] -> Maybe (Position a)
+mean [] = Nothing
+mean [p] = Just p
+mean ps =
+    if null antipodals
+        then Just (nvh nv zero (model . head $ ps))
+        else Nothing
+  where
+    vs = fmap nvec ps
+    ts = filter (\l -> length l == 2) (subsequences vs)
+    antipodals = filter (\t -> (realToFrac (vnorm (vadd (head t) (last t)) :: Double) :: Nano) == 0) ts
+    nv = vunit $ foldl vadd vzero vs
+
+-- private
+alongTrackDistance'' :: (Spherical a) => Position a -> Position a -> Vector3d -> Length
+alongTrackDistance'' p s n = arcLength a (radius s)
+  where
+    a = signedAngle (nvec s) (vcross (vcross n (nvec p)) n) (Just n)
+
+-- | [p1, p2, p3, p4] to [(p1, p2), (p2, p3), (p3, p4), (p4, p1)]
+egdes :: [Vector3d] -> [(Vector3d, Vector3d)]
+egdes ps = zip ps (tail ps ++ [head ps])
+
+lrph :: Length -> Length -> Double -> Length
+lrph h0 h1 f = metres h
+  where
+    h0' = toMetres h0
+    h1' = toMetres h1
+    h = h0' + (h1' - h0') * f
+
+intersections' :: (Spherical a) => Vector3d -> Vector3d -> a -> Maybe (Position a, Position a)
+intersections' n1 n2 s
+    | (vnorm i :: Double) == 0.0 = Nothing
+    | otherwise
+    , let ni = nvh (vunit i) zero s = Just (ni, antipode ni)
+  where
+    i = vcross n1 n2
+
+initialBearing' :: Position a -> Position a -> Angle
+initialBearing' p1 p2 = normalise a (decimalDegrees 360)
+  where
+    v1 = nvec p1
+    v2 = nvec p2
+    gc1 = vcross v1 v2 -- great circle through p1 & p2
+    gc2 = vcross v1 nvNorthPole -- great circle through p1 & north pole
+    a = radians (signedAngleRadians gc1 gc2 (Just v1))
+
+-- | reference sphere radius.
+radius :: (Spherical a) => Position a -> Length
+radius = equatorialRadius . surface . model
+
+normal' :: (Spherical a) => Position a -> Position a -> Vector3d
+normal' p1 p2 = vcross (nvec p1) (nvec p2)
+
+signedAngle :: Vector3d -> Vector3d -> Maybe Vector3d -> Angle
+signedAngle v1 v2 n = radians (signedAngleRadians v1 v2 n)
src/Data/Geo/Jord/Internal.hs view
@@ -1,37 +1,35 @@--- |--- Module:      Data.Geo.Jord.Internal--- Copyright:   (c) 2018 Cedric Liegeois--- License:     BSD3--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>--- Stability:   experimental--- Portability: portable------ internal functions.----module Data.Geo.Jord.Internal-    ( ad-    , nvec-    , sad-    ) where--import Data.Geo.Jord.AngularPosition (pos)-import Data.Geo.Jord.Transformation (NTransform(..))-import Data.Geo.Jord.Vector3d---- | angle in  __radians__ between 2 /n/-vectors (as 'Vector3d').-ad :: Vector3d -> Vector3d -> Double-ad v1 v2 = sad v1 v2 Nothing---- | /n/-vector (as a 'Vector3d') from given position.-nvec :: (NTransform a) => a -> Vector3d-nvec = vec . pos . toNVector---- | Signed angle in __radians__ between 2 /n/-vectors (as 'Vector3d').--- If @n@ is 'Nothing', the angle is always in [0..pi], otherwise it is in [-pi, +pi],--- signed + if @v1@ is clockwise looking along @n@, - in opposite direction.-sad :: Vector3d -> Vector3d -> Maybe Vector3d -> Double-sad v1 v2 n = atan2 sinO cosO-  where-    sign = maybe 1 (signum . vdot (vcross v1 v2)) n-    sinO = sign * vnorm (vcross v1 v2)-    cosO = vdot v1 v2+-- |
+-- Module:      Data.Geo.Jord.Internal
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- internal functions.
+--
+module Data.Geo.Jord.Internal
+    ( angleRadians
+    , signedAngleRadians
+    , llEq
+    ) where
+
+import Data.Geo.Jord.Position
+
+-- | angle in __radians__ between 2 vectors.
+angleRadians :: Vector3d -> Vector3d -> Double
+angleRadians v1 v2 = signedAngleRadians v1 v2 Nothing
+
+-- | Signed angle in __radians__ between 2 vectors.
+-- If @n@ is 'Nothing', the angle is always in [0..pi], otherwise it is in [-pi, +pi],
+-- signed + if @v1@ is clockwise looking along @n@, - in opposite direction.
+signedAngleRadians :: Vector3d -> Vector3d -> Maybe Vector3d -> Double
+signedAngleRadians v1 v2 n = atan2 sinO cosO
+  where
+    sign = maybe 1 (signum . vdot (vcross v1 v2)) n
+    sinO = sign * vnorm (vcross v1 v2)
+    cosO = vdot v1 v2
+
+-- | both position have same latitude and longitude irrespective of model ?
+llEq :: Position a -> Position a -> Bool
+llEq p1 p2 = latitude p1 == latitude p2 && longitude p1 == longitude p2
src/Data/Geo/Jord/Kinematics.hs view
@@ -1,418 +1,460 @@-{-# LANGUAGE FlexibleInstances #-}---- |--- Module:      Data.Geo.Jord.Kinematics--- Copyright:   (c) 2018 Cedric Liegeois--- License:     BSD3--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>--- Stability:   experimental--- Portability: portable------ Types and functions for working with kinematics calculations assuming a __spherical__ earth model.------ All functions are implemented using the vector-based approached described in--- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>--- and in <https://calhoun.nps.edu/bitstream/handle/10945/29516/sometacticalalgo00shud.pdf Shudde, Rex H. (1986). Some tactical algorithms for spherical geometry>----module Data.Geo.Jord.Kinematics-    (-    -- * The 'Track' type.-    Track(..)-    -- * The 'Course' type.-    , Course-    -- * The 'Cpa' type.-    , Cpa-    , cpaTime-    , cpaDistance-    , cpaPosition1-    , cpaPosition2-    -- * The 'Intercept' type.-    , Intercept-    , interceptTime-    , interceptDistance-    , interceptPosition-    , interceptorBearing-    , interceptorSpeed-    -- * Calculations-    , course-    , position-    , position84-    , cpa-    , cpa84-    , intercept-    , intercept84-    , interceptBySpeed-    , interceptBySpeed84-    , interceptByTime-    , interceptByTime84-    ) where--import Control.Applicative-import Data.Geo.Jord.Angle-import Data.Geo.Jord.AngularPosition-import Data.Geo.Jord.Duration-import Data.Geo.Jord.Earth-import Data.Geo.Jord.Geodetics-import Data.Geo.Jord.Internal(ad, nvec)-import Data.Geo.Jord.LatLong-import Data.Geo.Jord.Length-import Data.Geo.Jord.NVector-import Data.Geo.Jord.Quantity-import Data.Geo.Jord.Speed-import Data.Geo.Jord.Transformation-import Data.Geo.Jord.Vector3d-import Data.Maybe (isNothing)---- | 'Track' represents the state of a vehicle by its current position, bearing and speed.-data Track a = Track-    { trackPos :: a -- ^ position of the track.-    , trackBearing :: Angle -- ^ bearing of the track.-    , trackSpeed :: Speed -- ^ speed of the track.-    } deriving (Eq, Show)---- | 'GreatCircle' from track.-instance NTransform a => IsGreatCircle (Track a) where-    greatCircleE t = greatCircleE (trackPos t, trackBearing t)---- | 'GreatArc' from track and duration using the mean radius of the WGS84 reference ellipsoid.-instance NTransform a => IsGreatArc (Track a, Duration) where-    greatArcE (t, d) = greatArcE (t, d, r84)---- | 'GreatArc' from track, duration and earth mean radius.-instance NTransform a => IsGreatArc (Track a, Duration, Length) where-    greatArcE (t, d, r) = greatArcE (trackPos t, position t d r)---- | 'Course' represents the cardinal direction in which the vehicle is to be steered.-newtype Course =-    Course Vector3d-    deriving (Eq, Show)--instance IsVector3d Course where-    vec (Course v) = v---- | Time to, and distance at, closest point of approach (CPA) as well as position of both tracks at CPA.-data Cpa a = Cpa-    { cpaTime :: Duration -- ^ time to CPA.-    , cpaDistance :: Length -- ^ distance at CPA.-    , cpaPosition1 :: a -- ^ position of track 1 at CPA.-    , cpaPosition2 :: a -- ^ position of track 2 at CPA.-    } deriving (Eq, Show)---- | Time, distance and position of intercept as well as speed and initial bearing of interceptor.-data Intercept a = Intercept-    { interceptTime :: Duration -- ^ time to intercept.-    , interceptDistance :: Length -- ^ distance at intercept.-    , interceptPosition :: a -- ^ position of intercept.-    , interceptorBearing :: Angle -- ^ initial bearing of interceptor.-    , interceptorSpeed :: Speed -- ^ speed of interceptor.-    } deriving (Eq, Show)---- | @course p b@ computes the course of a vehicle currently at position @p@ and following bearing @b@.-course :: (NTransform a) => a -> Angle -> Course-course p b = Course (Vector3d (vz (head r)) (vz (r !! 1)) (vz (r !! 2)))-  where-    ll = nvectorToLatLong . pos . toNVector $ p-    lat = latitude ll-    lon = longitude ll-    r = mdot (mdot (rz (negate' lon)) (ry lat)) (rx b)---- | @position t d r@ computes the position of a track @t@ after duration @d@ has elapsed and using the earth radius @r@.------ @---     let p0 = latLongHeight (readLatLong "531914N0014347W") (metres 15000)---     let b = decimalDegrees 96.0217---     let s = kilometresPerHour 124.8---     let p1 = decimalLatLongHeight 53.1882691 0.1332741 (metres 15000)---     position (Track p0 b s) (hours 1) r84 = p1--- @-position :: (NTransform a) => Track a -> Duration -> Length -> a-position (Track p0 b s) d = position' p0 s (course p0 b) (toSeconds d)---- | 'position' using the mean radius of the WGS84 reference ellipsoid.-position84 :: (NTransform a) => Track a -> Duration -> a-position84 t d = position t d r84---- | @cpa t1 t2 r@ computes the closest point of approach between tracks @t1@ and @t2@ and using the earth radius @r@.------ @---     let p1 = decimalLatLong 20 (-60)---     let b1 = decimalDegrees 10---     let s1 = knots 15---     let p2 = decimalLatLong 34 (-50)---     let b2 = decimalDegrees 220---     let s2 = knots 300---     let t1 = Track p1 b1 s1---     let t2 = Track p2 b2 s2---     let c = cpa t1 t2 r84---     fmap cpaTime c = Just (milliseconds 11396155)---     fmap cpaDistance c = Just (kilometres 124.2317453)--- @-cpa :: (Eq a, NTransform a) => Track a -> Track a -> Length -> Maybe (Cpa a)-cpa (Track p1 b1 s1) (Track p2 b2 s2) r-    | p1 == p2 = Just (Cpa zero zero p1 p2)-    | t < 0 = Nothing-    | otherwise = Just (Cpa (seconds t) d cp1 cp2)-  where-    c1 = course p1 b1-    c2 = course p2 b2-    t = timeToCpa p1 c1 s1 p2 c2 s2 r-    cp1 = position' p1 s1 c1 t r-    cp2 = position' p2 s2 c2 t r-    d = surfaceDistance cp1 cp2 r---- | 'cpa' using the mean radius of the WGS84 reference ellipsoid.-cpa84 :: (Eq a, NTransform a) => Track a -> Track a -> Maybe (Cpa a)-cpa84 t1 t2 = cpa t1 t2 r84---- | @intercept t p r@ computes the __minimum__ speed of interceptor at--- position @p@ needed for an intercept with target track @t@ to take place--- using the earth radius @r@. Intercept time, position, distance and interceptor--- bearing are derived from this minimum speed. Returns 'Nothing' if intercept--- cannot be achieved e.g.:------     * interceptor and target are at the same position------     * interceptor is "behind" the target------ @---     let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)---     let ip = (decimalLatLong 20 (-60))---     let i = intercept t ip r84---     fmap interceptorSpeed i = Just (knots 52.633367756059)---     fmap interceptTime i = Just (seconds 5993.831)--- @-intercept :: (Eq a, NTransform a) => Track a -> a -> Length -> Maybe (Intercept a)-intercept t p r = interceptByTime t p (seconds (timeToIntercept t p r)) r---- | 'intercept' using the mean radius of the WGS84 reference ellipsoid.-intercept84 :: (Eq a, NTransform a) => Track a -> a -> Maybe (Intercept a)-intercept84 t p = intercept t p r84---- | @interceptBySpeed t p s r@ computes the time needed by interceptor at--- position @p@ and travelling at speed @s@ to intercept target track @t@--- using the earth radius @r@. Returns 'Nothing' if intercept--- cannot be achieved e.g.:------     * interceptor and target are at the same position------     * interceptor speed is below minimum speed returned by 'intercept'-interceptBySpeed :: (Eq a, NTransform a) => Track a -> a -> Speed -> Length -> Maybe (Intercept a)-interceptBySpeed t p s r-    | isNothing minInt = Nothing-    | fmap interceptorSpeed minInt == Just s = minInt-    | otherwise = interceptByTime t p (seconds (timeToInterceptSpeed t p s r)) r-  where-    minInt = intercept t p r---- | 'interceptBySpeed' using the mean radius of the WGS84 reference ellipsoid.-interceptBySpeed84 :: (Eq a, NTransform a) => Track a -> a -> Speed -> Maybe (Intercept a)-interceptBySpeed84 t p s = interceptBySpeed t p s r84---- | @interceptByTime t p d r@ computes the speed of interceptor at--- position @p@ needed for an intercept with target track @t@ to take place--- after duration @d@ and using the earth radius @r@. Returns 'Nothing' if--- given duration is <= 0 or interceptor and target are at the same position.------ @---     let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)---     let ip = (decimalLatLong 20 (-60))---     let d = seconds 2700---     let i = interceptByTime t ip d r84---     fmap interceptorSpeed i = Just (knots 730.959238)---     fmap interceptorBearing i = Just (decimalDegrees 26.1199030)---     fmap interceptPosition i = Just (decimalLatLong 28.1366797 (-55.4559475))---     fmap interceptDistance i = Just (metres 1015302.3815)---     fmap interceptTime i = Just (seconds 2700)--- @------ Note: contrary to 'intercept' and 'interceptBySpeed' this function handles--- cases where the interceptor has to catch up the target.-interceptByTime :: (Eq a, NTransform a) => Track a -> a -> Duration -> Length -> Maybe (Intercept a)-interceptByTime t p d r-    | toMilliseconds d <= 0 = Nothing-    | trackPos t == p = Nothing-    | otherwise = fmap (\b -> Intercept d idist ipos b is) ib-  where-    ipos = position t d r-    idist = surfaceDistance p ipos r-    ib = initialBearing p ipos <|> initialBearing p (trackPos t)-    is = metresPerSecond (toMetres idist / toSeconds d)---- | 'interceptByTime' using the mean radius of the WGS84 reference ellipsoid.-interceptByTime84 :: (Eq a, NTransform a) => Track a -> a -> Duration -> Maybe (Intercept a)-interceptByTime84 t p d = interceptByTime t p d r84---- | position from speed course and seconds.-position' :: (NTransform a) => a -> Speed -> Course -> Double -> Length -> a-position' p0 s c sec r = fromNVector (nvectorHeight (nvector (vx v1) (vy v1) (vz v1)) h0)-  where-    nv0 = toNVector p0-    v0 = vec . pos $nv0-    h0 = height nv0-    v1 = position'' v0 s (vec c) sec r---- | position from speed course and seconds.-position'' :: Vector3d -> Speed -> Vector3d -> Double -> Length -> Vector3d-position'' v0 s c sec r = v1-  where-    a = toMetresPerSecond s / toMetres r * sec-    v1 = vadd (vscale v0 (cos a)) (vscale c (sin a))---- | time to CPA.-timeToCpa :: (NTransform a) => a -> Course -> Speed -> a -> Course -> Speed -> Length -> Double-timeToCpa p1 c1 s1 p2 c2 s2 r = cpaNrRec v10 c10 w1 v20 c20 w2 0 0-  where-    v10 = nvec p1-    c10 = vec c1-    rm = toMetres r-    w1 = toMetresPerSecond s1 / rm-    v20 = nvec p2-    c20 = vec c2-    w2 = toMetresPerSecond s2 / rm---- | time to intercept with minimum speed-timeToIntercept :: (NTransform a) => Track a -> a -> Length -> Double-timeToIntercept (Track p2 b2 s2) p1 r = intMinNrRec v10v20 v10c2 w2 (sep v10 v20 c2 s2 r) t0 0-  where-    v10 = nvec p1-    v20 = nvec p2-    c2 = vec (course p2 b2)-    v10v20 = vdot v10 v20-    v10c2 = vdot v10 c2-    s2mps = toMetresPerSecond s2-    rm = toMetres r-    w2 = s2mps / rm-    s0 = ad v10 v20 -- initial angular distance between target and interceptor-    t0 = rm * s0 / s2mps -- assume target is travelling towards interceptor---- | time to intercept with speed.-timeToInterceptSpeed :: (NTransform a) => Track a -> a -> Speed -> Length -> Double-timeToInterceptSpeed (Track p2 b2 s2) p1 s1 r =-    intSpdNrRec v10v20 v10c2 w1 w2 (sep v10 v20 c2 s2 r) t0 0-  where-    v10 = nvec p1-    v20 = nvec p2-    c2 = vec (course p2 b2)-    v10v20 = vdot v10 v20-    v10c2 = vdot v10 c2-    rm = toMetres r-    w1 = toMetresPerSecond s1 / rm-    w2 = toMetresPerSecond s2 / rm-    t0 = 0.1--rx :: Angle -> [Vector3d]-rx a = [Vector3d 1 0 0, Vector3d 0 c s, Vector3d 0 (-s) c]-  where-    c = cos' a-    s = sin' a--ry :: Angle -> [Vector3d]-ry a = [Vector3d c 0 (-s), Vector3d 0 1 0, Vector3d s 0 c]-  where-    c = cos' a-    s = sin' a--rz :: Angle -> [Vector3d]-rz a = [Vector3d c s 0, Vector3d (-s) c 0, Vector3d 0 0 1]-  where-    c = cos' a-    s = sin' a--cpaA :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double-cpaA v10 c10 w1 v20 c20 w2 = negate (vdot (vscale v10 w1) c20 + vdot (vscale v20 w2) c10)--cpaB :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double-cpaB v10 c10 w1 v20 c20 w2 = vdot (vscale c10 w1) v20 + vdot (vscale c20 w2) v10--cpaC :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double-cpaC v10 c10 w1 v20 c20 w2 = negate (vdot (vscale v10 w1) v20 - vdot (vscale c20 w2) c10)--cpaD :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double-cpaD v10 c10 w1 v20 c20 w2 = vdot (vscale c10 w1) c20 - vdot (vscale v20 w2) v10--cpaFt :: Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double-cpaFt cw1t cw2t sw1t sw2t a b c d =-    a * sw1t * sw2t + b * cw1t * cw2t + c * sw1t * cw2t + d * cw1t * sw2t--cpaDft ::-       Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-    -> Double-cpaDft w1 w2 cw1t cw2t sw1t sw2t a b c d =-    negate ((c * w2 + d * w1) * sw1t * sw2t) + (d * w2 + c * w1) * cw1t * cw2t +-    (a * w2 - b * w1) * sw1t * cw2t --    (b * w2 - a * w1) * cw1t * sw2t--cpaStep :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double -> Double-cpaStep v10 c10 w1 v20 c20 w2 t =-    cpaFt cw1t cw2t sw1t sw2t a b c d / cpaDft w1 w2 cw1t cw2t sw1t sw2t a b c d-  where-    cw1t = cos (w1 * t)-    cw2t = cos (w2 * t)-    sw1t = sin (w1 * t)-    sw2t = sin (w2 * t)-    a = cpaA v10 c10 w1 v20 c20 w2-    b = cpaB v10 c10 w1 v20 c20 w2-    c = cpaC v10 c10 w1 v20 c20 w2-    d = cpaD v10 c10 w1 v20 c20 w2---- | Newton-Raphson for CPA time.-cpaNrRec ::-       Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double -> Int -> Double-cpaNrRec v10 c10 w1 v20 c20 w2 ti i-    | i == 50 = -1.0 -- no convergence-    | abs fi < 1e-11 = ti1-    | otherwise = cpaNrRec v10 c10 w1 v20 c20 w2 ti1 (i + 1)-  where-    fi = cpaStep v10 c10 w1 v20 c20 w2 ti-    ti1 = ti - fi---- | Newton-Raphson for min speed intercept.-intMinNrRec :: Double -> Double -> Double -> (Double -> Double) -> Double -> Int -> Double-intMinNrRec v10v20 v10c2 w2 st ti i-    | i == 50 = -1.0 -- no convergence-    | abs fi < 1e-11 = ti1-    | otherwise = intMinNrRec v10v20 v10c2 w2 st ti1 (i + 1)-  where-    cosw2t = cos (w2 * ti)-    sinw2t = sin (w2 * ti)-    v10dv2dt = (-w2) * (v10v20 * sinw2t - v10c2 * cosw2t)-    v10d2v2dt2 = (-1.0 * w2 * w2) * (v10v20 * cosw2t + v10c2 * sinw2t)-    si = st ti-    sinS = sin si-    a = (-1.0) / sinS-    b = cos si / (sinS * sinS)-    f = ti * a * v10dv2dt - si-    d2sdt2 = a * (b * v10dv2dt * v10dv2dt + v10d2v2dt2)-    df = ti * d2sdt2-    fi = f / df-    ti1 = ti - fi---- | Newton-Raphson for speed intercept.-intSpdNrRec :: Double -> Double -> Double -> Double -> (Double -> Double) -> Double -> Int -> Double-intSpdNrRec v10v20 v10c2 w1 w2 st ti i-    | i == 50 = -1.0 -- no convergence-    | abs fi < 1e-11 = ti1-    | otherwise = intSpdNrRec v10v20 v10c2 w1 w2 st ti1 (i + 1)-  where-    cosw2t = cos (w2 * ti)-    sinw2t = sin (w2 * ti)-    si = st ti-    f = si / ti - w1-    dsdt = (w2 * (v10v20 * sinw2t - v10c2 * cosw2t)) / sin si-    df = (dsdt - (si / ti)) / ti-    fi = f / df-    ti1 = ti - fi---- | angular separation in radians at ti between v10 and track with initial position v20,--- course c2 and speed s2.-sep :: Vector3d -> Vector3d -> Vector3d -> Speed -> Length -> Double -> Double-sep v10 v20 c2 s2 r ti = ad v10 (position'' v20 s2 c2 ti r)+-- |
+-- Module:      Data.Geo.Jord.Kinematics
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Types and functions for working with kinematics calculations assuming a __spherical__ celestial body.
+--
+-- In order to use this module you should start with the following imports:
+--
+-- @
+--     import Data.Geo.Jord.Kinematics
+--     import Data.Geo.Jord.Position
+-- @
+--
+-- All functions are implemented using the vector-based approached described in
+-- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
+-- and in <https://calhoun.nps.edu/bitstream/handle/10945/29516/sometacticalalgo00shud.pdf Shudde, Rex H. (1986). Some tactical algorithms for spherical geometry>
+--
+module Data.Geo.Jord.Kinematics
+    (
+    -- * The 'Track' type.
+      Track(..)
+    -- * The 'Course' type.
+    , Course
+    -- * The 'Cpa' type.
+    , Cpa
+    , cpaTime
+    , cpaDistance
+    , cpaPosition1
+    , cpaPosition2
+    -- * The 'Intercept' type.
+    , Intercept
+    , interceptTime
+    , interceptDistance
+    , interceptPosition
+    , interceptorBearing
+    , interceptorSpeed
+    -- * Calculations
+    , course
+    , positionAfter
+    , trackPositionAfter
+    , cpa
+    , intercept
+    , interceptBySpeed
+    , interceptByTime
+    -- * re-exported for convenience
+    , module Data.Geo.Jord.Duration
+    , module Data.Geo.Jord.Speed
+    ) where
+
+import Control.Applicative ((<|>))
+import Data.Maybe (fromJust, isNothing)
+
+import Data.Geo.Jord.Duration
+import Data.Geo.Jord.GreatCircle
+import Data.Geo.Jord.Internal
+import Data.Geo.Jord.Position
+import Data.Geo.Jord.Speed
+
+-- | 'Track' represents the state of a vehicle by its current position, bearing and speed.
+data Track a =
+    Track
+        { trackPosition :: Position a -- ^ position of the track.
+        , trackBearing :: Angle -- ^ bearing of the track.
+        , trackSpeed :: Speed -- ^ speed of the track.
+        }
+    deriving (Eq, Show)
+
+-- | 'Course' represents the cardinal direction in which the vehicle is to be steered.
+newtype Course =
+    Course Vector3d
+    deriving (Eq, Show)
+
+-- | Time to, and distance at, closest point of approach (CPA) as well as position of both tracks at CPA.
+data Cpa a =
+    Cpa
+        { cpaTime :: Duration -- ^ time to CPA.
+        , cpaDistance :: Length -- ^ distance at CPA.
+        , cpaPosition1 :: Position a -- ^ position of track 1 at CPA.
+        , cpaPosition2 :: Position a -- ^ position of track 2 at CPA.
+        }
+    deriving (Eq, Show)
+
+-- | Time, distance and position of intercept as well as speed and initial bearing of interceptor.
+data Intercept a =
+    Intercept
+        { interceptTime :: Duration -- ^ time to intercept.
+        , interceptDistance :: Length -- ^ distance at intercept.
+        , interceptPosition :: Position a -- ^ position of intercept.
+        , interceptorBearing :: Angle -- ^ initial bearing of interceptor.
+        , interceptorSpeed :: Speed -- ^ speed of interceptor.
+        }
+    deriving (Eq, Show)
+
+-- | @course p b@ computes the course of a vehicle currently at position @p@ and following bearing @b@.
+course :: (Spherical a) => Position a -> Angle -> Course
+course p b = Course (Vector3d (vz (head r)) (vz (r !! 1)) (vz (r !! 2)))
+  where
+    lat = latitude p
+    lon = longitude p
+    r = mdot (mdot (rz (negate' lon)) (ry lat)) (rx b)
+
+-- | @positionAfter p b s d@ computes the position of a vehicle currently at position @p@
+-- following bearing @b@ and travelling at speed @s@ after duration @d@ has elapsed assuming
+-- the vehicle maintains a __constant__ altitude.
+--
+-- @positionAfter p b s d@ is a shortcut for @positionAfter' ('course' p b) s d@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Kinematics
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p = s84Pos 53.321 (-1.729) (metres 15000)
+-- >>> let b = decimalDegrees 96.0217
+-- >>> let s = kilometresPerHour 124.8
+-- >>> positionAfter p b s (hours 1)
+-- 53°11'19.368"N,0°8'2.457"E 15.0km (S84)
+-- @
+positionAfter :: (Spherical a) => Position a -> Angle -> Speed -> Duration -> Position a
+positionAfter p b s d = position' p (course p b) s (toSeconds d)
+
+-- | @positionAfter p c s d@ computes the position of a vehicle currently at position @p@
+-- on course @c@ and travelling at speed @s@ after duration @d@ has elapsed assuming
+-- the vehicle maintains a __constant__ altitude.
+positionAfter' :: (Spherical a) => Position a -> Course -> Speed -> Duration -> Position a
+positionAfter' p c s d = position' p c s (toSeconds d)
+
+-- | @trackPositionAfter t d@ computes the position of a track @t@ after duration @d@ has elapsed
+-- assuming the vehicle maintains a __constant__ altitude.
+--
+-- @trackPositionAfter ('Track' p b s) d@ is a equivalent to @positionAfter' p ('course' p b) s d@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Kinematics
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p = s84Pos 53.321 (-1.729) (metres 15000)
+-- >>> let b = decimalDegrees 96.0217
+-- >>> let s = kilometresPerHour 124.8
+-- >>> trackPositionAfter (Track p b s) (hours 1)
+-- 53°11'19.368"N,0°8'2.457"E 15.0km (S84)
+--
+trackPositionAfter :: (Spherical a) => Track a -> Duration -> Position a
+trackPositionAfter (Track p b s) = positionAfter' p (course p b) s
+
+-- | @cpa t1 t2@ computes the closest point of approach between tracks @t1@ and @t2@ disregarding
+-- their respective altitude.
+-- If a closest point of approach is found, height of 'cpaPosition1' - respectively 'cpaPosition2',
+-- will be the altitude of the first - respectively second, track.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Kinematics
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = s84Pos 20 (-60) zero
+-- >>> let b1 = decimalDegrees 10
+-- >>> let s1 = knots 15
+-- >>> let p2 = s84Pos 34 (-50) zero
+-- >>> let b2 = decimalDegrees 220
+-- >>> let s2 = knots 300
+-- >>> let t1 = Track p1 b1 s1
+-- >>> let t2 = Track p2 b2 s2
+-- >>> let c = cpa t1 t2
+-- >>> fmap cpaTime c
+-- Just 3H9M56.155S
+-- >>> fmap cpaDistance c
+-- Just 124.2317453km
+--
+cpa :: (Spherical a) => Track a -> Track a -> Maybe (Cpa a)
+cpa (Track p1 b1 s1) (Track p2 b2 s2)
+    | llEq p1 p2 = Just (Cpa zero zero p1 p2)
+    | t < 0 = Nothing
+    | otherwise = Just (Cpa (seconds t) d cp1 cp2)
+  where
+    c1 = course p1 b1
+    c2 = course p2 b2
+    t = timeToCpa p1 c1 s1 p2 c2 s2
+    cp1 = position' p1 c1 s1 t
+    cp2 = position' p2 c2 s2 t
+    d = surfaceDistance cp1 cp2
+
+-- | @intercept t p@ computes the __minimum__ speed of interceptor at
+-- position @p@ needed for an intercept with target track @t@ to take place.
+-- Intercept time, position, distance and interceptor bearing are derived from
+-- this minimum speed. Returns 'Nothing' if intercept cannot be achieved e.g.:
+--
+--     * interceptor and target are at the same position
+--
+--     * interceptor is "behind" the target
+--
+-- If found, 'interceptPosition' is at the altitude of the track.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Kinematics
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+-- >>> let ip = s84Pos 20 (-60) zero
+-- >>> let i = intercept t ip
+-- >>> fmap (toKnots . interceptorSpeed) i
+-- Just 52.633367756059
+-- >>> fmap (toSeconds . interceptTime) i
+-- Just 5993.831
+--
+intercept :: (Spherical a) => Track a -> Position a -> Maybe (Intercept a)
+intercept t p = interceptByTime t p (seconds (timeToIntercept t p))
+
+-- | @interceptBySpeed t p s@ computes the time needed by interceptor at
+-- position @p@ and travelling at speed @s@ to intercept target track @t@.
+-- Returns 'Nothing' if intercept cannot be achieved e.g.:
+--
+--     * interceptor and target are at the same position
+--
+--     * interceptor speed is below minimum speed returned by 'intercept'
+--
+-- If found, 'interceptPosition' is at the altitude of the track.
+--
+interceptBySpeed :: (Spherical a) => Track a -> Position a -> Speed -> Maybe (Intercept a)
+interceptBySpeed t p s
+    | isNothing minInt = Nothing
+    | fmap interceptorSpeed minInt == Just s = minInt
+    | otherwise = interceptByTime t p (seconds (timeToInterceptSpeed t p s))
+  where
+    minInt = intercept t p
+
+-- | @interceptByTime t p d@ computes the speed of interceptor at
+-- position @p@ needed for an intercept with target track @t@ to take place
+-- after duration @d@. Returns 'Nothing' if given duration is <= 0 or
+-- interceptor and target are at the same position.
+--
+-- If found, 'interceptPosition' is at the altitude of the track.
+--
+-- Note: contrary to 'intercept' and 'interceptBySpeed' this function handles
+-- cases where the interceptor has to catch up the target.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Kinematics
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+-- >>> let ip = s84Pos 20 (-60) zero
+-- >>> let d = seconds 2700
+-- >>> let i = interceptByTime t ip d
+-- >>> fmap (toKnots . interceptorSpeed) i
+-- Just 730.959238
+-- >>>
+-- >>> fmap interceptorBearing i
+-- Just 26°7'11.649"
+-- >>>
+-- >>> fmap interceptPosition i
+-- Just 28°8'12.047"N,55°27'21.411"W 0.0m (S84)
+-- >>>
+-- >>> fmap interceptDistance i
+-- Just 1015.3023506km
+-- >>>
+-- >>> fmap (toSeconds . interceptTime) i
+-- Just 2700
+--
+interceptByTime :: (Spherical a) => Track a -> Position a -> Duration -> Maybe (Intercept a)
+interceptByTime t p d
+    | toMilliseconds d <= 0 = Nothing
+    | llEq (trackPosition t) p = Nothing
+    | isNothing ib = Nothing
+    | otherwise =
+        let is = averageSpeed idist d
+         in Just (Intercept d idist ipos (fromJust ib) is)
+  where
+    ipos = trackPositionAfter t d
+    idist = surfaceDistance p ipos
+    ib = initialBearing p ipos <|> initialBearing p (trackPosition t)
+
+-- private
+-- | position from speed course and seconds.
+position' :: (Spherical a) => Position a -> Course -> Speed -> Double -> Position a
+position' p0 (Course c) s sec = nvh v1 h0 (model p0)
+  where
+    nv0 = nvec p0
+    h0 = height p0
+    v1 = position'' nv0 c s sec (radiusM p0)
+
+-- | position from course, speed and seconds.
+position'' :: Vector3d -> Vector3d -> Speed -> Double -> Double -> Vector3d
+position'' v0 c s sec rm = v1
+  where
+    a = toMetresPerSecond s / rm * sec
+    v1 = vadd (vscale v0 (cos a)) (vscale c (sin a))
+
+-- | time to CPA.
+timeToCpa ::
+       (Spherical a) => Position a -> Course -> Speed -> Position a -> Course -> Speed -> Double
+timeToCpa p1 (Course c10) s1 p2 (Course c20) s2 = cpaNrRec v10 c10 w1 v20 c20 w2 0 0
+  where
+    v10 = nvec p1
+    rm = radiusM p1
+    w1 = toMetresPerSecond s1 / rm
+    v20 = nvec p2
+    w2 = toMetresPerSecond s2 / rm
+
+-- | time to intercept with minimum speed
+timeToIntercept :: (Spherical a) => Track a -> Position a -> Double
+timeToIntercept (Track p2 b2 s2) p1 = intMinNrRec v10v20 v10c2 w2 (sep v10 v20 c2 s2 rm) t0 0
+  where
+    v10 = nvec p1
+    v20 = nvec p2
+    (Course c2) = course p2 b2
+    v10v20 = vdot v10 v20
+    v10c2 = vdot v10 c2
+    s2mps = toMetresPerSecond s2
+    rm = radiusM p1
+    w2 = s2mps / rm
+    s0 = angleRadians v10 v20 -- initial angular distance between target and interceptor
+    t0 = rm * s0 / s2mps -- assume target is travelling towards interceptor
+
+-- | time to intercept with speed.
+timeToInterceptSpeed :: (Spherical a) => Track a -> Position a -> Speed -> Double
+timeToInterceptSpeed (Track p2 b2 s2) p1 s1 =
+    intSpdNrRec v10v20 v10c2 w1 w2 (sep v10 v20 c2 s2 rm) t0 0
+  where
+    v10 = nvec p1
+    v20 = nvec p2
+    (Course c2) = course p2 b2
+    v10v20 = vdot v10 v20
+    v10c2 = vdot v10 c2
+    rm = radiusM p1
+    w1 = toMetresPerSecond s1 / rm
+    w2 = toMetresPerSecond s2 / rm
+    t0 = 0.1
+
+rx :: Angle -> [Vector3d]
+rx a = [Vector3d 1 0 0, Vector3d 0 c s, Vector3d 0 (-s) c]
+  where
+    c = cos' a
+    s = sin' a
+
+ry :: Angle -> [Vector3d]
+ry a = [Vector3d c 0 (-s), Vector3d 0 1 0, Vector3d s 0 c]
+  where
+    c = cos' a
+    s = sin' a
+
+rz :: Angle -> [Vector3d]
+rz a = [Vector3d c s 0, Vector3d (-s) c 0, Vector3d 0 0 1]
+  where
+    c = cos' a
+    s = sin' a
+
+cpaA :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double
+cpaA v10 c10 w1 v20 c20 w2 = negate (vdot (vscale v10 w1) c20 + vdot (vscale v20 w2) c10)
+
+cpaB :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double
+cpaB v10 c10 w1 v20 c20 w2 = vdot (vscale c10 w1) v20 + vdot (vscale c20 w2) v10
+
+cpaC :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double
+cpaC v10 c10 w1 v20 c20 w2 = negate (vdot (vscale v10 w1) v20 - vdot (vscale c20 w2) c10)
+
+cpaD :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double
+cpaD v10 c10 w1 v20 c20 w2 = vdot (vscale c10 w1) c20 - vdot (vscale v20 w2) v10
+
+cpaFt :: Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double
+cpaFt cw1t cw2t sw1t sw2t a b c d =
+    a * sw1t * sw2t + b * cw1t * cw2t + c * sw1t * cw2t + d * cw1t * sw2t
+
+cpaDft ::
+       Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+    -> Double
+cpaDft w1 w2 cw1t cw2t sw1t sw2t a b c d =
+    negate ((c * w2 + d * w1) * sw1t * sw2t) + (d * w2 + c * w1) * cw1t * cw2t +
+    (a * w2 - b * w1) * sw1t * cw2t -
+    (b * w2 - a * w1) * cw1t * sw2t
+
+cpaStep :: Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double -> Double
+cpaStep v10 c10 w1 v20 c20 w2 t =
+    cpaFt cw1t cw2t sw1t sw2t a b c d / cpaDft w1 w2 cw1t cw2t sw1t sw2t a b c d
+  where
+    cw1t = cos (w1 * t)
+    cw2t = cos (w2 * t)
+    sw1t = sin (w1 * t)
+    sw2t = sin (w2 * t)
+    a = cpaA v10 c10 w1 v20 c20 w2
+    b = cpaB v10 c10 w1 v20 c20 w2
+    c = cpaC v10 c10 w1 v20 c20 w2
+    d = cpaD v10 c10 w1 v20 c20 w2
+
+-- | Newton-Raphson for CPA time.
+cpaNrRec ::
+       Vector3d -> Vector3d -> Double -> Vector3d -> Vector3d -> Double -> Double -> Int -> Double
+cpaNrRec v10 c10 w1 v20 c20 w2 ti i
+    | i == 50 = -1.0 -- no convergence
+    | abs fi < 1e-11 = ti1
+    | otherwise = cpaNrRec v10 c10 w1 v20 c20 w2 ti1 (i + 1)
+  where
+    fi = cpaStep v10 c10 w1 v20 c20 w2 ti
+    ti1 = ti - fi
+
+-- | Newton-Raphson for min speed intercept.
+intMinNrRec :: Double -> Double -> Double -> (Double -> Double) -> Double -> Int -> Double
+intMinNrRec v10v20 v10c2 w2 st ti i
+    | i == 50 = -1.0 -- no convergence
+    | abs fi < 1e-11 = ti1
+    | otherwise = intMinNrRec v10v20 v10c2 w2 st ti1 (i + 1)
+  where
+    cosw2t = cos (w2 * ti)
+    sinw2t = sin (w2 * ti)
+    v10dv2dt = (-w2) * (v10v20 * sinw2t - v10c2 * cosw2t)
+    v10d2v2dt2 = (-1.0 * w2 * w2) * (v10v20 * cosw2t + v10c2 * sinw2t)
+    si = st ti
+    sinS = sin si
+    a = (-1.0) / sinS
+    b = cos si / (sinS * sinS)
+    f = ti * a * v10dv2dt - si
+    d2sdt2 = a * (b * v10dv2dt * v10dv2dt + v10d2v2dt2)
+    df = ti * d2sdt2
+    fi = f / df
+    ti1 = ti - fi
+
+-- | Newton-Raphson for speed intercept.
+intSpdNrRec :: Double -> Double -> Double -> Double -> (Double -> Double) -> Double -> Int -> Double
+intSpdNrRec v10v20 v10c2 w1 w2 st ti i
+    | i == 50 = -1.0 -- no convergence
+    | abs fi < 1e-11 = ti1
+    | otherwise = intSpdNrRec v10v20 v10c2 w1 w2 st ti1 (i + 1)
+  where
+    cosw2t = cos (w2 * ti)
+    sinw2t = sin (w2 * ti)
+    si = st ti
+    f = si / ti - w1
+    dsdt = (w2 * (v10v20 * sinw2t - v10c2 * cosw2t)) / sin si
+    df = (dsdt - (si / ti)) / ti
+    fi = f / df
+    ti1 = ti - fi
+
+-- | angular separation in radians at ti between v10 and track with initial position v20,
+-- course c2 and speed s2.
+sep :: Vector3d -> Vector3d -> Vector3d -> Speed -> Double -> Double -> Double
+sep v10 v20 c2 s2 r ti = angleRadians v10 (position'' v20 c2 s2 ti r)
+
+-- | reference sphere radius.
+radius :: (Spherical a) => Position a -> Length
+radius = equatorialRadius . surface . model
+
+-- | reference sphere radius in metres.
+radiusM :: (Spherical a) => Position a -> Double
+radiusM = toMetres . radius
src/Data/Geo/Jord/LatLong.hs view
@@ -1,215 +1,128 @@ -- |
 -- Module:      Data.Geo.Jord.LatLong
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
 -- Portability: portable
 --
--- Geodetic latitude and longitude.
+-- Functions related to latitudes & longitudes.
 --
 module Data.Geo.Jord.LatLong
-    (
-    -- * The 'LatLong' type
-      LatLong
-    , latitude
-    , longitude
-    -- * Smart constructors
-    , latLong
-    , latLongE
-    , latLongF
-    , decimalLatLong
-    , decimalLatLongE
-    , decimalLatLongF
-    -- * read
-    , readLatLong
-    , readLatLongE
-    , readLatLongF
-    -- * Misc.
-    , toDecimalDegrees'
+    ( isValidLatLong
+    , latLongDmsP
+    , latLongDmsCompactP
+    , latLongDmsSymbolsP
+    , showLatLong
     ) where
 
-import Control.Applicative hiding (many)
-import Control.Monad.Fail
-import Data.Char
+import Control.Applicative ((<|>))
+import Control.Monad.Fail (MonadFail)
+import Data.Char ()
+import Data.Maybe ()
+import Text.ParserCombinators.ReadP (ReadP, char, option, pfail)
+
 import Data.Geo.Jord.Angle
+import Data.Geo.Jord.Model
 import Data.Geo.Jord.Parser
-import Data.Maybe
-import Prelude hiding (fail)
-import Text.ParserCombinators.ReadP
-import Text.Read hiding (pfail)
 
--- | Horizontal position defined by its geodetic latitude and longitude.
-data LatLong = LatLong
-    { latitude :: Angle -- ^ geodetic latitude
-    , longitude :: Angle -- ^ longitude
-    } deriving (Eq)
-
--- | See 'readLatLong'.
-instance Read LatLong where
-    readsPrec _ = readP_to_S ll
-
--- | Produced string format: d°(m')(s'')[N|S],d°(m')(s'')[E|W] - e.g. 55°36'21''N,13°0'2''E.
-instance Show LatLong where
-    show (LatLong lat lon) = showLat lat ++ "," ++ showLon lon
-
--- | 'LatLong' from given latitude and longitude.
--- 'error's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-latLong :: Angle -> Angle -> LatLong
-latLong lat lon =
-    fromMaybe
-        (error ("Invalid latitude=" ++ show lat ++ " or longitude=" ++ show lon))
-        (latLongF lat lon)
-
--- | 'LatLong' from given latitude and longitude.
--- A 'Left' indicates that the given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-latLongE :: Angle -> Angle -> Either String LatLong
-latLongE lat lon
-    | not (isWithin lat (decimalDegrees (-90)) (decimalDegrees 90)) =
-        Left ("Invalid latitude=" ++ show lat)
-    | not (isWithin lon (decimalDegrees (-180)) (decimalDegrees 180)) =
-        Left ("Invalid longitude=" ++ show lon)
-    | otherwise = Right (LatLong lat lon)
-
--- | 'LatLong' from given latitude and longitude.
--- 'fail's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-latLongF :: (MonadFail m) => Angle -> Angle -> m LatLong
-latLongF lat lon =
-    case e of
-        Left err -> fail err
-        Right g -> return g
-  where
-    e = latLongE lat lon
-
--- | 'LatLong' from given latitude and longitude in __decimal degrees__.
--- 'error's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLong :: Double -> Double -> LatLong
-decimalLatLong lat lon = latLong (decimalDegrees lat) (decimalDegrees lon)
-
--- | 'LatLong' from given latitude and longitude in __decimal degrees__.
--- A 'Left' indicates that the given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLongE :: Double -> Double -> Either String LatLong
-decimalLatLongE lat lon = latLongE (decimalDegrees lat) (decimalDegrees lon)
-
--- | 'LatLong' from given latitude and longitude in __decimal degrees__.
--- 'fail's if given latitude is outisde [-90..90]° and/or
--- given longitude is outisde [-180..180]°.
-decimalLatLongF :: (MonadFail m) => Double -> Double -> m LatLong
-decimalLatLongF lat lon = latLongF (decimalDegrees lat) (decimalDegrees lon)
+-- | @isValidLatLong lat lon m@ determines whether the given latitude & longitude are
+-- both valid for model @m@.
+isValidLatLong :: (Model a) => Angle -> Angle -> a -> Bool
+isValidLatLong lat lon m = isValidLat lat && isValidLong lon m
 
--- | Obtains a 'LatLong' from the given string formatted as either:
+-- | latitude and longitude reader.
+-- Formats:
 --
 --     * DD(MM)(SS)[N|S]DDD(MM)(SS)[E|W] - e.g. 553621N0130002E or 0116S03649E or 47N122W
 --
 --     * 'Angle'[N|S] 'Angle'[E|W] - e.g. 55°36'21''N 13°0'02''E or 11°16'S 36°49'E or 47°N 122°W
 --
--- This simply calls @read s :: GeoPos@ so 'error' should be handled at the call site.
---
-readLatLong :: String -> LatLong
-readLatLong s = read s :: LatLong
-
--- | Same as 'readLatLong' but returns a 'Either'.
-readLatLongE :: String -> Either String LatLong
-readLatLongE s =
-    case readMaybe s of
-        Nothing -> Left ("couldn't read geo pos " ++ s)
-        Just g -> Right g
-
--- | Same as 'readLatLong' but returns a 'MonadFail'.
-readLatLongF :: (MonadFail m) => String -> m LatLong
-readLatLongF s =
-    let pg = readLatLongE s
-     in case pg of
-            Left e -> fail e
-            Right g -> return g
-
--- | Converts the given 'LatLong' to tuple of latitude and longitude in decimal degrees.
-toDecimalDegrees' :: LatLong -> (Double, Double)
-toDecimalDegrees' g = (toDecimalDegrees (latitude g), toDecimalDegrees (longitude g))
-
--- | Parses and returns a 'LatLong'.
-ll :: ReadP LatLong
-ll = block <|> human
+latLongDmsP :: (Model a) => a -> ReadP (Angle, Angle)
+latLongDmsP m = latLongDmsCompactP m <|> latLongDmsSymbolsP m
 
--- | Parses and returns a 'LatLong' - DD(D)MMSS.
-block :: ReadP LatLong
-block = do
+-- | reads latitude and longitude in DD(D)MMSS.
+latLongDmsCompactP :: (Model a) => a -> ReadP (Angle, Angle)
+latLongDmsCompactP m = do
     lat <- blat
     lon <- blon
-    latLongF lat lon
+    if isValidLatLong lat lon m
+        then return (lat, lon)
+        else pfail
 
--- | Parses and returns a latitude, DDMMSS expected.
+-- | reads latitude in DDMMSS.
 blat :: ReadP Angle
 blat = do
     d' <- digits 2
-    (m', s') <- option (0, 0) (ms <|> m)
+    (m', s') <- option (0, 0.0) (ms <|> mi)
     h <- hemisphere
     if h == 'N'
-        then dmsF d' m' s' 0
-        else dmsF (-d') m' s' 0
+        then dmsF d' m' s'
+        else dmsF (-d') m' s'
 
--- | Parses and returns a longitude, DDDMMSS expected.
+-- | reads longitude in DDDMMSS.
 blon :: ReadP Angle
 blon = do
     d' <- digits 3
-    (m', s') <- option (0, 0) (ms <|> m)
+    (m', s') <- option (0, 0.0) (ms <|> mi)
     m'' <- meridian
     if m'' == 'E'
-        then dmsF d' m' s' 0
-        else dmsF (-d') m' s' 0
+        then dmsF d' m' s'
+        else dmsF (-d') m' s'
 
--- | Parses N or S char.
+-- | reads N or S char.
 hemisphere :: ReadP Char
 hemisphere = char 'N' <|> char 'S'
 
--- | Parses E or W char.
+-- | reads E or W char.
 meridian :: ReadP Char
 meridian = char 'E' <|> char 'W'
 
--- | Parses minutes and seconds.
-ms :: ReadP (Int, Int)
+-- | reads minutes and seconds.
+ms :: ReadP (Int, Double)
 ms = do
     m' <- digits 2
     s' <- digits 2
-    return (m', s')
+    return (m', fromIntegral s')
 
--- | Parses minutes.
-m :: ReadP (Int, Int)
-m = do
+-- | reads minutes.
+mi :: ReadP (Int, Double)
+mi = do
     m' <- digits 2
-    return (m', 0)
+    return (m', 0.0)
 
--- | Parses and returns a 'LatLong' from a human friendly text - see 'Angle'.
-human :: ReadP LatLong
-human = do
+-- | reads (latitude, longitude) from a human friendly text - see 'Angle'.
+latLongDmsSymbolsP :: (Model a) => a -> ReadP (Angle, Angle)
+latLongDmsSymbolsP m = do
     lat <- hlat
     _ <- char ' ' <|> char ','
     lon <- hlon
-    latLongF lat lon
+    if isValidLatLong lat lon m
+        then return (lat, lon)
+        else pfail
 
--- | Parses and returns a latitude, 'Angle'N|S expected.
+-- | reads a latitude, 'Angle'N|S expected.
 hlat :: ReadP Angle
 hlat = do
-    lat <- angle
+    lat <- angleP
     h <- hemisphere
     if h == 'N'
         then return lat
         else return (negate' lat)
 
--- | Parses and returns a longitude, 'Angle'E|W expected.
+-- | reads a longitude, 'Angle'E|W expected.
 hlon :: ReadP Angle
 hlon = do
-    lon <- angle
+    lon <- angleP
     m' <- meridian
     if m' == 'E'
         then return lon
         else return (negate' lon)
 
+-- | Show a (latitude, longitude) pair as DMS - e.g. 55°36'21''N,13°0'2''E.
+showLatLong :: (Angle, Angle) -> String
+showLatLong (lat, lon) = showLat lat ++ "," ++ showLon lon
+
 -- | Latitude to string.
 showLat :: Angle -> String
 showLat lat
@@ -221,3 +134,20 @@ showLon lon
     | isNegative lon = show (negate' lon) ++ "W"
     | otherwise = show lon ++ "E"
+
+dmsF :: (MonadFail m) => Int -> Int -> Double -> m Angle
+dmsF degs mins secs =
+    case e of
+        Left err -> fail err
+        Right a -> return a
+  where
+    e = dms degs mins secs
+
+isValidLat :: Angle -> Bool
+isValidLat a = isWithin a (decimalDegrees (-90)) (decimalDegrees 90)
+
+isValidLong :: (Model a) => Angle -> a -> Bool
+isValidLong a m =
+    case longitudeRange m of
+        L180 -> isWithin a (decimalDegrees (-180)) (decimalDegrees 180)
+        L360 -> isWithin a (decimalDegrees 0) (decimalDegrees 360)
src/Data/Geo/Jord/Length.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Length
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -18,104 +18,94 @@     , metres
     , nauticalMiles
     -- * Read
+    , lengthP
     , readLength
-    , readLengthE
-    , readLengthF
     -- * Conversions
     , toFeet
     , toKilometres
     , toMetres
+    , toMillimetres
     , toNauticalMiles
     ) where
 
-import Control.Applicative
-import Control.Monad.Fail
+import Control.Applicative ((<|>))
+import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S, skipSpaces, string)
+import Text.Read (readMaybe)
+
 import Data.Geo.Jord.Parser
 import Data.Geo.Jord.Quantity
-import Prelude hiding (fail, length)
-import Text.ParserCombinators.ReadP
-import Text.Read hiding (pfail)
 
--- | A length with a resolution of 0.1 millimetre.
-newtype Length = Length
-    { tenthOfMm :: Int
-    } deriving (Eq)
+-- | A length with a resolution of 1 micrometre.
+newtype Length =
+    Length
+        { micrometre :: Int
+        }
+    deriving (Eq)
 
--- | See 'readLength'.
+-- | See 'lengthP'.
 instance Read Length where
-    readsPrec _ = readP_to_S length
+    readsPrec _ = readP_to_S lengthP
 
--- | Length is shown in metres when absolute value is <= 10,000 m and in kilometres otherwise.
+-- | Length is shown in metres when absolute value is <= 10 km and in kilometres otherwise.
 instance Show Length where
     show l
-        | abs m <= 10000.0 = show m ++ "m"
-        | otherwise = show (m / 1000.0) ++ "km"
-      where
-        m = toMetres l
+        | abs' l <= (kilometres 10) = show (toMetres l) ++ "m"
+        | otherwise = show (toKilometres l) ++ "km"
 
+instance Ord Length where
+    (<=) (Length l1) (Length l2) = l1 <= l2
+
 -- | Add/Subtract 'Length's.
 instance Quantity Length where
-    add a b = Length (tenthOfMm a + tenthOfMm b)
-    sub a b = Length (tenthOfMm a - tenthOfMm b)
+    add a b = Length (micrometre a + micrometre b)
+    sub a b = Length (micrometre a - micrometre b)
     zero = Length 0
 
 -- | 'Length' from given amount of feet.
 feet :: Double -> Length
-feet ft = Length (round (ft * 3048.0))
+feet ft = Length (round (ft * 0.3048 * m2um))
 
 -- | 'Length' from given amount of kilometres.
 kilometres :: Double -> Length
-kilometres km = Length (round (km * 10000000.0))
+kilometres km = Length (round (km * 1000.0 * m2um))
 
 -- | 'Length' from given amount of metres.
 metres :: Double -> Length
-metres m = Length (round (m * 10000.0))
+metres m = Length (round (m * m2um))
 
 -- | 'Length' from given amount of nautical miles.
 nauticalMiles :: Double -> Length
-nauticalMiles nm = Length (round (nm * 18520000.0))
-
--- | Obtains a 'Length' from the given string formatted as (-)float[m|km|nm|ft] - e.g. 3000m, 2.5km, -154nm or 10000ft.
---
--- This simply calls @read s :: Length@ so 'error' should be handled at the call site.
---
-readLength :: String -> Length
-readLength s = read s :: Length
-
--- | Same as 'readLength' but returns a 'Either'.
-readLengthE :: String -> Either String Length
-readLengthE s =
-    case readMaybe s of
-        Nothing -> Left ("couldn't read length " ++ s)
-        Just l -> Right l
+nauticalMiles nm = Length (round (nm * 1852.0 * m2um))
 
--- | Same as 'readLength' but returns a 'MonadFail'.
-readLengthF :: (MonadFail m) => String -> m Length
-readLengthF s =
-    let p = readEither s
-     in case p of
-            Left e -> fail e
-            Right l -> return l
+-- | Reads an a 'Length' from the given string using 'lengthP'.
+readLength :: String -> Maybe Length
+readLength s = readMaybe s :: (Maybe Length)
 
 -- | @toFeet l@ converts @l@ to feet.
 toFeet :: Length -> Double
-toFeet (Length l) = fromIntegral l / 3048.0
+toFeet (Length l) = fromIntegral l / (0.3048 * m2um)
 
 -- | @toKilometres l@ converts @l@ to kilometres.
 toKilometres :: Length -> Double
-toKilometres (Length l) = fromIntegral l / 10000000.0
+toKilometres (Length l) = fromIntegral l / (1000.0 * m2um)
 
 -- | @toMetres l@ converts @l@ to metres.
 toMetres :: Length -> Double
-toMetres (Length l) = fromIntegral l / 10000.0
+toMetres (Length l) = fromIntegral l / m2um
 
+-- | @toMillimetres l@ converts @l@ to millimetres.
+toMillimetres :: Length -> Double
+toMillimetres (Length l) = fromIntegral l / 1000.0
+
 -- | @toNauticalMiles l@ converts @l@ to nautical miles.
 toNauticalMiles :: Length -> Double
-toNauticalMiles (Length l) = fromIntegral l / 18520000.0
+toNauticalMiles (Length l) = fromIntegral l / (1852.0 * m2um)
 
--- | Parses and returns a 'Length'.
-length :: ReadP Length
-length = do
+-- | Parses and returns a 'Length' formatted as (-)float[m|km|nm|ft].
+-- e.g. 3000m, 2.5km, -154nm or 10000ft.
+--
+lengthP :: ReadP Length
+lengthP = do
     v <- number
     skipSpaces
     u <- string "m" <|> string "km" <|> string "nm" <|> string "ft"
@@ -125,3 +115,10 @@         "nm" -> return (nauticalMiles v)
         "ft" -> return (feet v)
         _ -> pfail
+
+-- | metre to micrometre.
+m2um :: Double
+m2um = 1000.0 * 1000.0
+
+abs' :: Length -> Length
+abs' (Length um) = Length (abs um)
+ src/Data/Geo/Jord/LocalFrames.hs view
@@ -0,0 +1,356 @@+-- |
+-- Module:      Data.Geo.Jord.LocalFrames
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Type and functions for working with delta vectors in different local reference frames: all frames are location dependent.
+--
+-- In order to use this module you should start with the following imports:
+--
+-- @
+--     import Data.Geo.Jord.LocalFrames
+--     import Data.Geo.Jord.Position
+-- @
+--
+-- All functions are implemented using the vector-based approached described in
+-- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
+--
+-- Notes:
+--
+--     * The term Earth is used to be consistent with the paper. However any celestial body reference frame can be used.
+--
+--     * Though the API accept spherical models, doing so defeats the purpose of this module
+--       which is to find exact solutions. Prefer using ellipsoidal models.
+--
+module Data.Geo.Jord.LocalFrames
+    (
+    -- * Local Reference frame
+      LocalFrame(..)
+    -- * Body frame
+    , FrameB
+    , yaw
+    , pitch
+    , roll
+    , bOrigin
+    , frameB
+    -- * Local level/wander azimuth frame
+    , FrameL
+    , wanderAzimuth
+    , lOrigin
+    , frameL
+    -- * North-East-Down frame
+    , FrameN
+    , nOrigin
+    , frameN
+    -- * Deltas
+    , Delta
+    , delta
+    , deltaMetres
+    , dx
+    , dy
+    , dz
+    -- * Delta in the north, east, down frame
+    , Ned
+    , ned
+    , nedMetres
+    , north
+    , east
+    , down
+    , bearing
+    , elevation
+    , slantRange
+    -- * Calculations
+    , deltaBetween
+    , nedBetween
+    , target
+    , targetN
+    -- * re-exported for convenience
+    , module Data.Geo.Jord.Rotation
+    ) where
+
+import Data.Geo.Jord.Position
+import Data.Geo.Jord.Rotation
+
+-- | class for local reference frames: a reference frame which is location dependant.
+--
+-- Supported frames:
+--
+--     * 'FrameB': 'rEF' returns R_EB
+--
+--     * 'FrameL': 'rEF' returns R_EL
+--
+--     * 'FrameN': 'rEF' returns R_EN
+--
+class LocalFrame a where
+    rEF :: a -> [Vector3d] -- ^ rotation matrix to transform vectors decomposed in frame @a@ to vectors decomposed Earth-Fixed frame.
+
+-- | Body frame (typically of a vehicle).
+--
+--     * Position: The origin is in the vehicle’s reference point.
+--
+--     * Orientation: The x-axis points forward, the y-axis to the right (starboard) and the z-axis
+-- in the vehicle’s down direction.
+--
+--      * Comments: The frame is fixed to the vehicle.
+--
+data FrameB a =
+    FrameB
+        { yaw :: Angle -- ^ body yaw angle (vertical axis).
+        , pitch :: Angle -- ^ body pitch angle (transverse axis).
+        , roll :: Angle -- ^ body roll angle (longitudinal axis).
+        , bOrigin :: Position a -- ^ frame origin.
+        }
+    deriving (Eq, Show)
+
+-- | 'FrameB' from given yaw, pitch, roll, position (origin).
+frameB :: (Model a) => Angle -> Angle -> Angle -> Position a -> FrameB a
+frameB = FrameB
+
+-- | R_EB: frame B to Earth
+instance LocalFrame (FrameB a) where
+    rEF (FrameB y p r o) = rm
+      where
+        rNB = zyx2r y p r
+        n = FrameN o
+        rEN = rEF n
+        rm = mdot rEN rNB -- closest frames cancel: N
+
+-- | Local level, Wander azimuth frame.
+--
+--     * Position: The origin is directly beneath or above the vehicle (B), at Earth’s surface (surface
+-- of ellipsoid model).
+--
+--     * Orientation: The z-axis is pointing down. Initially, the x-axis points towards north, and the
+-- y-axis points towards east, but as the vehicle moves they are not rotating about the z-axis
+-- (their angular velocity relative to the Earth has zero component along the z-axis).
+-- (Note: Any initial horizontal direction of the x- and y-axes is valid for L, but if the
+-- initial position is outside the poles, north and east are usually chosen for convenience.)
+--
+--     * Comments: The L-frame is equal to the N-frame except for the rotation about the z-axis,
+-- which is always zero for this frame (relative to Earth). Hence, at a given time, the only
+-- difference between the frames is an angle between the x-axis of L and the north direction;
+-- this angle is called the wander azimuth angle. The L-frame is well suited for general
+-- calculations, as it is non-singular.
+--
+data FrameL a =
+    FrameL
+        { wanderAzimuth :: Angle -- ^ wander azimuth: angle between x-axis of the frame L and the north direction.
+        , lOrigin :: Position a -- ^ frame origin.
+        }
+    deriving (Eq, Show)
+
+-- | R_EL: frame L to Earth
+instance LocalFrame (FrameL m) where
+    rEF (FrameL w o) = rm
+      where
+        lat = latitude o
+        lon = longitude o
+        r = xyz2r lon (negate' lat) w
+        rEe' = [Vector3d 0 0 (-1), Vector3d 0 1 0, Vector3d 1 0 0]
+        rm = mdot rEe' r
+
+-- | 'FrameL' from given wander azimuth, position (origin).
+frameL :: (Model a) => Angle -> Position a -> FrameL a
+frameL = FrameL
+
+-- | North-East-Down (local level) frame.
+--
+--     * Position: The origin is directly beneath or above the vehicle (B), at Earth’s surface (surface
+-- of ellipsoid model).
+--
+--     * Orientation: The x-axis points towards north, the y-axis points towards east (both are
+-- horizontal), and the z-axis is pointing down.
+--
+--     * Comments: When moving relative to the Earth, the frame rotates about its z-axis to allow the
+-- x-axis to always point towards north. When getting close to the poles this rotation rate
+-- will increase, being infinite at the poles. The poles are thus singularities and the direction of
+-- the x- and y-axes are not defined here. Hence, this coordinate frame is not suitable for
+-- general calculations.
+--
+newtype FrameN a =
+    FrameN
+        { nOrigin :: Position a -- ^ frame origin.
+        }
+    deriving (Eq, Show)
+
+-- | R_EN: frame N to Earth
+instance LocalFrame (FrameN a) where
+    rEF (FrameN o) = transpose rm
+      where
+        vo = nvec o
+        np = nvNorthPole
+        rd = vscale vo (-1) -- down (pointing opposite to n-vector)
+        re = vunit (vcross np vo) -- east (pointing perpendicular to the plane)
+        rn = vcross re rd -- north (by right hand rule)
+        rm = [rn, re, rd]
+
+-- | 'FrameN' from given position (origin).
+frameN :: (Model a) => Position a -> FrameN a
+frameN = FrameN
+
+-- | delta between position in one of the reference frames.
+newtype Delta =
+    Delta Vector3d
+    deriving (Eq, Show)
+
+-- | 'Delta' from given x, y and z length.
+delta :: Length -> Length -> Length -> Delta
+delta x y z = Delta (Vector3d (toMetres x) (toMetres y) (toMetres z))
+
+-- | 'Delta' from given x, y and z length in __metres__.
+deltaMetres :: Double -> Double -> Double -> Delta
+deltaMetres x y z = delta (metres x) (metres y) (metres z)
+
+-- | x component of given 'Delta'.
+dx :: Delta -> Length
+dx (Delta v) = metres (vx v)
+
+-- | y component of given 'Delta'.
+dy :: Delta -> Length
+dy (Delta v) = metres (vy v)
+
+-- | z component of given 'Delta'.
+dz :: Delta -> Length
+dz (Delta v) = metres (vz v)
+
+-- | North, east and down delta (thus in frame 'FrameN').
+newtype Ned =
+    Ned Vector3d
+    deriving (Eq, Show)
+
+-- | 'Ned' from given north, east and down.
+ned :: Length -> Length -> Length -> Ned
+ned n e d = Ned (Vector3d (toMetres n) (toMetres e) (toMetres d))
+
+-- | 'Ned' from given north, east and down in __metres__.
+nedMetres :: Double -> Double -> Double -> Ned
+nedMetres n e d = ned (metres n) (metres e) (metres d)
+
+-- | North component of given 'Ned'.
+north :: Ned -> Length
+north (Ned v) = metres (vx v)
+
+-- | East component of given 'Ned'.
+east :: Ned -> Length
+east (Ned v) = metres (vy v)
+
+-- | Down component of given 'Ned'.
+down :: Ned -> Length
+down (Ned v) = metres (vz v)
+
+-- | @bearing v@ computes the bearing in compass angle of the NED vector @v@ from north.
+--
+-- Compass angles are clockwise angles from true north: 0 = north, 90 = east, 180 = south, 270 = west.
+--
+bearing :: Ned -> Angle
+bearing v =
+    let a = atan2' (toMetres (east v)) (toMetres (north v))
+     in normalise a (decimalDegrees 360.0)
+
+-- | @elevation v@ computes the elevation of the NED vector @v@ from horizontal (ie tangent to ellipsoid surface).
+elevation :: Ned -> Angle
+elevation (Ned v) = negate' (asin' (vz v / vnorm v))
+
+-- | @slantRange v@ computes the distance from origin in the local system of the NED vector @v@.
+slantRange :: Ned -> Length
+slantRange (Ned v) = metres (vnorm v)
+
+-- | @deltaBetween p1 p2 f@ computes the exact 'Delta' between the two
+-- positions @p1@ and @p2@ in local frame @f@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.LocalFrames
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = wgs84Pos 1 2 (metres (-3))
+-- >>> let p2 = wgs84Pos 4 5 (metres (-6))
+-- >>> let w = decimalDegrees 5 -- wander azimuth
+-- >>> deltaBetween p1 p2 (frameL w)
+-- Delta (Vector3d {vx = 359490.5782, vy = 302818.5225, vz = 17404.2714})
+--
+deltaBetween :: (LocalFrame a, Model b) => Position b -> Position b -> (Position b -> a) -> Delta
+deltaBetween p1 p2 f = deltaMetres (vx d) (vy d) (vz d)
+  where
+    g1 = gcvec p1
+    g2 = gcvec p2
+    de = vsub g2 g1
+    -- rotation matrix to go from Earth Frame to Frame at p1
+    rm = transpose (rEF (f p1))
+    d = vmultm de rm
+
+-- | @nedBetween p1 p2@ computes the exact 'Ned' vector between the two
+-- positions @p1@ and @p2@, in north, east, and down.
+--
+-- Resulting 'Ned' delta is relative to @p1@: Due to the curvature of Earth and
+-- different directions to the North Pole, the north, east, and down directions
+-- will change (relative to Earth) for different places.
+--
+-- Position @p1@ must be outside the poles for the north and east directions to be defined.
+--
+-- This is equivalent to:
+--
+-- @
+--     'deltaBetween' p1 p2 'frameN'
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.LocalFrames
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p1 = wgs84Pos 1 2 (metres (-3))
+-- >>> let p2 = wgs84Pos 4 5 (metres (-6))
+-- >>> nedBetween p1 p2
+-- Ned (Vector3d {vx = 331730.2348, vy = 332997.875, vz = 17404.2714})
+--
+nedBetween :: (Model a) => Position a -> Position a -> Ned
+nedBetween p1 p2 = nedMetres (vx d) (vy d) (vz d)
+  where
+    (Delta d) = deltaBetween p1 p2 frameN
+
+-- | @target p0 f d@ computes the target position from position @p0@ and delta @d@ in local frame @f@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.LocalFrames
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p0 = wgs84Pos 49.66618 3.45063 zero
+-- >>> let y = decimalDegrees 10 -- yaw
+-- >>> let r = decimalDegrees 20 -- roll
+-- >>> let p = decimalDegrees 30 -- pitch
+-- >>> let d = deltaMetres 3000 2000 100
+-- >>> target p0 (frameB y r p) d
+-- 49°41'30.486"N,3°28'52.561"E 6.0077m (WGS84)
+--
+target :: (LocalFrame a, Model b) => Position b -> (Position b -> a) -> Delta -> Position b
+target p0 f (Delta d) = geocentricMetresPos x y z (model p0)
+  where
+    g0 = gcvec p0
+    rm = rEF (f p0)
+    c = vmultm d rm
+    (Vector3d x y z) = vadd g0 c
+
+-- | @targetN p0 d@ computes the target position from position @p0@ and north, east, down @d@.
+--
+-- This is equivalent to:
+--
+-- @
+--     'target' p0 'frameN' ('Delta' d)
+-- @
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.LocalFrames
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> let p0 = wgs84Pos 49.66618 3.45063 zero
+-- >>> targetN p0 (nedMeters 100 200 300)
+-- 49°40'1.485"N,3°27'12.242"E -299.9961m (WGS84)
+--
+targetN :: (Model a) => Position a -> Ned -> Position a
+targetN p0 (Ned d) = target p0 frameN (Delta d)
+ src/Data/Geo/Jord/Model.hs view
@@ -0,0 +1,77 @@+-- |
+-- Module:      Data.Geo.Jord.Model
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Definition of celestial body models.
+--
+-- see "Data.Geo.Jord.Models" for supported models.
+--
+module Data.Geo.Jord.Model
+    ( LongitudeRange(..)
+    , ModelId(..)
+    , Epoch(..)
+    , Model(..)
+    , Spherical
+    , Ellipsoidal
+    , EllipsoidalT0(..)
+    ) where
+
+import Data.Geo.Jord.Ellipsoid
+
+-- | Longitude range.
+data LongitudeRange
+    = L180 -- ^  [-180°, 180°]: range for Earth, Moon and Sun.
+    | L360 -- ^  [0°, 360°]: range for other celestial bodies (e.g. Mars).
+
+-- | Epoch (decimal years) such as 2018.60: the 219th day of the year or August 7, 2018
+-- in the Gregorian calendar.
+data Epoch =
+    Epoch Double
+    deriving (Eq, Show)
+
+-- | identifier of a model.
+newtype ModelId =
+    ModelId String
+    deriving (Eq)
+
+instance Show ModelId where
+    show (ModelId i) = i
+
+-- | Model for a celestial body: the same celestial body can be represented by different
+-- models (e.g. Earth: WGS84, ITRF2014, Spherical, etc...).
+class (Eq a, Show a) =>
+      Model a
+    where
+    modelId :: a -> ModelId -- ^ model identifier, must be unique for coordinate transformation.
+    surface :: a -> Ellipsoid -- ^ surface of the celestial body.
+    longitudeRange :: a -> LongitudeRange -- ^ longitude range.
+
+-- | Models that approximate the surface of the celestial body to a sphere.
+-- Such an approximation is satisfactory for many purposes and allows a wide
+-- range of calculations: see "Data.Geo.Jord.Kinematics", "Data.Geo.Jord.GreatCircle" and "Data.Geo.Jord.LocalFrames".
+class (Model a) =>
+      Spherical a
+
+
+-- | Models that represent the surface of the celestial body with an ellispoid.
+-- Compare to 'Spherical' models, less calculations are available and they are more CPU
+-- intensive: see "Data.Geo.Jord.Geodesic" and "Data.Geo.Jord.LocalFrames", however those
+-- calculations are more \"correct\".
+-- Supports coordinates transformation between different ellispoidal models using 7-parameter
+-- transformation (Helmert): see "Data.Geo.Jord.Transformation".
+class (Model a) =>
+      Ellipsoidal a
+
+
+-- | Time-dependent 'Ellipsoidal' models, such as International Terrestrial Reference Frames (ITRF).
+-- The epoch allows to account for unmodelled measurement biases and tectonic processes: supports
+-- coordinates transformation between different time-dependent ellispoidal models at given epoch using
+-- 15-parameter transformation (Helmert): see "Data.Geo.Jord.Transformation".
+class (Ellipsoidal a) =>
+      EllipsoidalT0 a
+    where
+    epoch :: a -> Epoch -- ^ epoch to which coordinates are referenced.
+ src/Data/Geo/Jord/Models.hs view
@@ -0,0 +1,530 @@+-- | +-- Module:      Data.Geo.Jord.Models +-- Copyright:   (c) 2020 Cedric Liegeois +-- License:     BSD3 +-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr> +-- Stability:   experimental +-- Portability: portable +--+-- Common ellipsoidal and spherical models.+--+-- This module has been generated.+--+module Data.Geo.Jord.Models where++import Data.Geo.Jord.Ellipsoids+import Data.Geo.Jord.Ellipsoid+import Data.Geo.Jord.Model++-- | World Geodetic System 1984.+data WGS84 = +    WGS84++instance Model WGS84 where+    modelId _ = ModelId "WGS84"+    surface _ = eWGS84+    longitudeRange _ = L180++instance Eq WGS84 where+    _ == _ = True++instance Show WGS84 where+    show m = show (modelId m)++instance Ellipsoidal WGS84++-- | Geodetic Reference System 1980.+data GRS80 = +    GRS80++instance Model GRS80 where+    modelId _ = ModelId "GRS80"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq GRS80 where+    _ == _ = True++instance Show GRS80 where+    show m = show (modelId m)++instance Ellipsoidal GRS80++-- | World Geodetic System 1972.+data WGS72 = +    WGS72++instance Model WGS72 where+    modelId _ = ModelId "WGS72"+    surface _ = eWGS72+    longitudeRange _ = L180++instance Eq WGS72 where+    _ == _ = True++instance Show WGS72 where+    show m = show (modelId m)++instance Ellipsoidal WGS72++-- | European Terrestrial Reference System 1989.+data ETRS89 = +    ETRS89++instance Model ETRS89 where+    modelId _ = ModelId "ETRS89"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ETRS89 where+    _ == _ = True++instance Show ETRS89 where+    show m = show (modelId m)++instance Ellipsoidal ETRS89++-- | North American Datum of 1983.+data NAD83 = +    NAD83++instance Model NAD83 where+    modelId _ = ModelId "NAD83"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq NAD83 where+    _ == _ = True++instance Show NAD83 where+    show m = show (modelId m)++instance Ellipsoidal NAD83++-- | European Datum 1950.+data ED50 = +    ED50++instance Model ED50 where+    modelId _ = ModelId "ED50"+    surface _ = eIntl1924+    longitudeRange _ = L180++instance Eq ED50 where+    _ == _ = True++instance Show ED50 where+    show m = show (modelId m)++instance Ellipsoidal ED50++-- | Irland.+data Irl1975 = +    Irl1975++instance Model Irl1975 where+    modelId _ = ModelId "Irl1975"+    surface _ = eAiryModified+    longitudeRange _ = L180++instance Eq Irl1975 where+    _ == _ = True++instance Show Irl1975 where+    show m = show (modelId m)++instance Ellipsoidal Irl1975++-- | North American Datum of 1927.+data NAD27 = +    NAD27++instance Model NAD27 where+    modelId _ = ModelId "NAD27"+    surface _ = eClarke1866+    longitudeRange _ = L180++instance Eq NAD27 where+    _ == _ = True++instance Show NAD27 where+    show m = show (modelId m)++instance Ellipsoidal NAD27++-- | NTF (Paris) / France I.+data NTF = +    NTF++instance Model NTF where+    modelId _ = ModelId "NTF"+    surface _ = eClarke1880IGN+    longitudeRange _ = L180++instance Eq NTF where+    _ == _ = True++instance Show NTF where+    show m = show (modelId m)++instance Ellipsoidal NTF++-- | Ordnance Survey Great Britain 1936.+data OSGB36 = +    OSGB36++instance Model OSGB36 where+    modelId _ = ModelId "OSGB36"+    surface _ = eAiry1830+    longitudeRange _ = L180++instance Eq OSGB36 where+    _ == _ = True++instance Show OSGB36 where+    show m = show (modelId m)++instance Ellipsoidal OSGB36++-- | Geodetic Datum for Germany.+data Potsdam = +    Potsdam++instance Model Potsdam where+    modelId _ = ModelId "Potsdam"+    surface _ = eBessel1841+    longitudeRange _ = L180++instance Eq Potsdam where+    _ == _ = True++instance Show Potsdam where+    show m = show (modelId m)++instance Ellipsoidal Potsdam++-- | Tokyo Japan.+data TokyoJapan = +    TokyoJapan++instance Model TokyoJapan where+    modelId _ = ModelId "TokyoJapan"+    surface _ = eBessel1841+    longitudeRange _ = L180++instance Eq TokyoJapan where+    _ == _ = True++instance Show TokyoJapan where+    show m = show (modelId m)++instance Ellipsoidal TokyoJapan++-- | Mars Orbiter Laser Altimeter.+data Mars2000 = +    Mars2000++instance Model Mars2000 where+    modelId _ = ModelId "Mars2000"+    surface _ = eMars2000+    longitudeRange _ = L360++instance Eq Mars2000 where+    _ == _ = True++instance Show Mars2000 where+    show m = show (modelId m)++instance Ellipsoidal Mars2000++-- | International Terrestrial Reference System (2014).+data ITRF2014 = +    ITRF2014++instance Model ITRF2014 where+    modelId _ = ModelId "ITRF2014"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF2014 where+    _ == _ = True++instance Show ITRF2014 where+    show m = show (modelId m)++instance Ellipsoidal ITRF2014++instance EllipsoidalT0 ITRF2014 where+    epoch _ = Epoch 2010.0++-- | International Terrestrial Reference System (2008).+data ITRF2008 = +    ITRF2008++instance Model ITRF2008 where+    modelId _ = ModelId "ITRF2008"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF2008 where+    _ == _ = True++instance Show ITRF2008 where+    show m = show (modelId m)++instance Ellipsoidal ITRF2008++instance EllipsoidalT0 ITRF2008 where+    epoch _ = Epoch 2005.0++-- | International Terrestrial Reference System (2005).+data ITRF2005 = +    ITRF2005++instance Model ITRF2005 where+    modelId _ = ModelId "ITRF2005"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF2005 where+    _ == _ = True++instance Show ITRF2005 where+    show m = show (modelId m)++instance Ellipsoidal ITRF2005++instance EllipsoidalT0 ITRF2005 where+    epoch _ = Epoch 2000.0++-- | International Terrestrial Reference System (2000).+data ITRF2000 = +    ITRF2000++instance Model ITRF2000 where+    modelId _ = ModelId "ITRF2000"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF2000 where+    _ == _ = True++instance Show ITRF2000 where+    show m = show (modelId m)++instance Ellipsoidal ITRF2000++instance EllipsoidalT0 ITRF2000 where+    epoch _ = Epoch 1997.0++-- | International Terrestrial Reference System (93).+data ITRF93 = +    ITRF93++instance Model ITRF93 where+    modelId _ = ModelId "ITRF93"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF93 where+    _ == _ = True++instance Show ITRF93 where+    show m = show (modelId m)++instance Ellipsoidal ITRF93++instance EllipsoidalT0 ITRF93 where+    epoch _ = Epoch 1988.0++-- | International Terrestrial Reference System (91).+data ITRF91 = +    ITRF91++instance Model ITRF91 where+    modelId _ = ModelId "ITRF91"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ITRF91 where+    _ == _ = True++instance Show ITRF91 where+    show m = show (modelId m)++instance Ellipsoidal ITRF91++instance EllipsoidalT0 ITRF91 where+    epoch _ = Epoch 1988.0++-- | World Geodetic System 1984 (G1762).+data WGS84_G1762 = +    WGS84_G1762++instance Model WGS84_G1762 where+    modelId _ = ModelId "WGS84_G1762"+    surface _ = eWGS84+    longitudeRange _ = L180++instance Eq WGS84_G1762 where+    _ == _ = True++instance Show WGS84_G1762 where+    show m = show (modelId m)++instance Ellipsoidal WGS84_G1762++instance EllipsoidalT0 WGS84_G1762 where+    epoch _ = Epoch 2005.0++-- | World Geodetic System 1984 (G1674).+data WGS84_G1674 = +    WGS84_G1674++instance Model WGS84_G1674 where+    modelId _ = ModelId "WGS84_G1674"+    surface _ = eWGS84+    longitudeRange _ = L180++instance Eq WGS84_G1674 where+    _ == _ = True++instance Show WGS84_G1674 where+    show m = show (modelId m)++instance Ellipsoidal WGS84_G1674++instance EllipsoidalT0 WGS84_G1674 where+    epoch _ = Epoch 2005.0++-- | World Geodetic System 1984 (G1150).+data WGS84_G1150 = +    WGS84_G1150++instance Model WGS84_G1150 where+    modelId _ = ModelId "WGS84_G1150"+    surface _ = eWGS84+    longitudeRange _ = L180++instance Eq WGS84_G1150 where+    _ == _ = True++instance Show WGS84_G1150 where+    show m = show (modelId m)++instance Ellipsoidal WGS84_G1150++instance EllipsoidalT0 WGS84_G1150 where+    epoch _ = Epoch 2001.0++-- | European Terrestrial Reference System (2000).+data ETRF2000 = +    ETRF2000++instance Model ETRF2000 where+    modelId _ = ModelId "ETRF2000"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq ETRF2000 where+    _ == _ = True++instance Show ETRF2000 where+    show m = show (modelId m)++instance Ellipsoidal ETRF2000++instance EllipsoidalT0 ETRF2000 where+    epoch _ = Epoch 2005.0++-- | NAD83 (Continuously Operating Reference Station 1996).+data NAD83_CORS96 = +    NAD83_CORS96++instance Model NAD83_CORS96 where+    modelId _ = ModelId "NAD83_CORS96"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq NAD83_CORS96 where+    _ == _ = True++instance Show NAD83_CORS96 where+    show m = show (modelId m)++instance Ellipsoidal NAD83_CORS96++instance EllipsoidalT0 NAD83_CORS96 where+    epoch _ = Epoch 1997.0++-- | Geocentric Datum Of Australia 1994.+data GDA94 = +    GDA94++instance Model GDA94 where+    modelId _ = ModelId "GDA94"+    surface _ = eGRS80+    longitudeRange _ = L180++instance Eq GDA94 where+    _ == _ = True++instance Show GDA94 where+    show m = show (modelId m)++instance Ellipsoidal GDA94++instance EllipsoidalT0 GDA94 where+    epoch _ = Epoch 1994.0++-- | Spherical Earth model derived from WGS84 ellipsoid.+data S84 = +    S84++instance Model S84 where+    modelId _ = ModelId "S84"+    surface _ = toSphere eWGS84+    longitudeRange _ = L180++instance Eq S84 where+    _ == _ = True++instance Show S84 where+    show m = show (modelId m)++instance Spherical S84++-- | Spherical Mars model derived from Mars2000 ellipsoid.+data SMars2000 = +    SMars2000++instance Model SMars2000 where+    modelId _ = ModelId "SMars2000"+    surface _ = toSphere eMars2000+    longitudeRange _ = L360++instance Eq SMars2000 where+    _ == _ = True++instance Show SMars2000 where+    show m = show (modelId m)++instance Spherical SMars2000++-- | Moon IAU/IAG.+data Moon = +    Moon++instance Model Moon where+    modelId _ = ModelId "Moon"+    surface _ = toSphere eMoon+    longitudeRange _ = L180++instance Eq Moon where+    _ == _ = True++instance Show Moon where+    show m = show (modelId m)++instance Spherical Moon+
− src/Data/Geo/Jord/NVector.hs 
@@ -1,41 +0,0 @@--- |
--- Module:      Data.Geo.Jord.NVector
--- Copyright:   (c) 2018 Cedric Liegeois
--- License:     BSD3
--- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
--- Stability:   experimental
--- Portability: portable
---
--- Types and functions for working with /n/-vectors.
---
-module Data.Geo.Jord.NVector
-    ( NVector
-    , nvector
-    , northPole
-    , southPole
-    ) where
-
-import Data.Geo.Jord.Vector3d
-
--- | Represents a position as the normal vector to the sphere.
---
--- Orientation: z-axis points to the North Pole along the Earth's rotation axis,
--- x-axis points towards the point where latitude = longitude = 0.
-newtype NVector =
-    NVector Vector3d
-    deriving (Eq, Show)
-
-instance IsVector3d NVector where
-    vec (NVector v) = v
-
--- | Unit 'NVector' from given x, y and z.
-nvector :: Double -> Double -> Double -> NVector
-nvector x y z = NVector (vunit (Vector3d x y z))
-
--- | Horizontal position of the North Pole.
-northPole :: NVector
-northPole = NVector (Vector3d 0.0 0.0 1.0)
-
--- | Horizontal position of the South Pole.
-southPole :: NVector
-southPole = NVector (Vector3d 0.0 0.0 (-1.0))
src/Data/Geo/Jord/Parser.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Parser
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -16,23 +16,23 @@     , number
     ) where
 
-import Control.Applicative
-import Data.Char
-import Text.ParserCombinators.ReadP
+import Control.Applicative ((<|>))
+import Data.Char (isDigit)
+import Text.ParserCombinators.ReadP (ReadP, char, count, munch1, option, satisfy)
 
 -- | Parses the given number of digits and returns the read 'Int'.
 digits :: Int -> ReadP Int
 digits n = fmap read (count n digit)
 
--- | Parses optionally a @-@ followed by a 'positive'.'positive' and returns the read 'Double'.
+-- | Parses optionally a @-@ followed by a 'natural'.'natural' and returns the read 'Double'.
 double :: ReadP Double
 double = do
     s <- option 1.0 (fmap (\_ -> -1.0) (char '-'))
     i <- natural
-    f <- char '.' >> natural
-    return (s * (read (show i ++ "." ++ show f) :: Double))
+    f <- char '.' >> munch1 isDigit
+    return (s * (read (show i ++ "." ++ f) :: Double))
 
--- | Parses optionally a @-@ followed by a 'positive' and returns the read 'Int'.
+-- | Parses optionally a @-@ followed by a 'natural' and returns the read 'Int'.
 integer :: ReadP Int
 integer = do
     s <- option 1 (fmap (\_ -> -1) (char '-'))
+ src/Data/Geo/Jord/Position.hs view
@@ -0,0 +1,539 @@+-- |
+-- Module:      Data.Geo.Jord.Position
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Position of points in specified models (e.g. WGS84) and conversion functions between
+-- coordinate system (geodetic to/from geocentric).
+--
+-- All functions are implemented using the vector-based approached described in
+-- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Point_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
+--
+-- See <http://clynchg3c.com/Technote/geodesy/coorddef.pdf Earth Coordinates>
+--
+module Data.Geo.Jord.Position
+    (
+    -- * The 'Position' type
+      Position
+    , latitude
+    , longitude
+    , height
+    , nvec
+    , gcvec
+    , model
+    -- * /n/-vector
+    , NVector
+    , nx
+    , ny
+    , nz
+    , nvector
+    -- * Geocentric coordinates
+    , Geocentric
+    , gx
+    , gy
+    , gz
+    , geocentric
+    -- * Smart constructors
+    , latLongPos
+    , latLongHeightPos
+    , latLongPos'
+    , latLongHeightPos'
+    , wgs84Pos
+    , wgs84Pos'
+    , s84Pos
+    , s84Pos'
+    , nvectorPos
+    , nvectorHeightPos
+    , geocentricPos
+    , geocentricMetresPos
+    , nvh
+    -- * Read/Show points
+    , readPosition
+    , positionP
+    -- * Vector3d conversions
+    , nvectorFromLatLong
+    , nvectorToLatLong
+    , nvectorFromGeocentric
+    , nvectorToGeocentric
+    -- * Misc.
+    , antipode
+    , latLong
+    , latLong'
+    , northPole
+    , southPole
+    , nvNorthPole
+    , nvSouthPole
+    -- * re-exported for convenience
+    , module Data.Geo.Jord.Angle
+    , module Data.Geo.Jord.Ellipsoid
+    , module Data.Geo.Jord.Ellipsoids
+    , module Data.Geo.Jord.LatLong
+    , module Data.Geo.Jord.Length
+    , module Data.Geo.Jord.Model
+    , module Data.Geo.Jord.Models
+    , module Data.Geo.Jord.Quantity
+    , module Data.Geo.Jord.Vector3d
+    ) where
+
+import Text.ParserCombinators.ReadP (ReadP, option, readP_to_S, skipSpaces)
+
+import Data.Geo.Jord.Angle
+import Data.Geo.Jord.Ellipsoid
+import Data.Geo.Jord.Ellipsoids
+import Data.Geo.Jord.LatLong
+import Data.Geo.Jord.Length
+import Data.Geo.Jord.Model
+import Data.Geo.Jord.Models
+import Data.Geo.Jord.Quantity
+import Data.Geo.Jord.Vector3d
+
+-- | Coordinates of a position in a specified 'Model'.
+-- A position provides both geodetic latitude & longitude, height and
+-- geocentric coordinates. The horizontal position
+-- (i.e. coordinates at the surface of the celestial body) is also provided
+-- as /n/-vector.
+--
+-- The "show" instance gives position in degrees, minutes, seconds,
+-- milliseconds ('Angle' "show" instance), height ('Length' "show" instance)
+-- and the model ('Model' "show" instance).
+--
+-- The "eq" instance returns True if and only if, both positions have the same
+-- horizontal position, height and model.
+data Position a =
+    Position
+        { latitude :: Angle -- ^ geodetic latitude
+        , longitude :: Angle -- ^ geodetic longitude
+        , height :: Length -- ^ height above the surface of the celestial body
+        , nvec :: !Vector3d -- ^ /n/-vector representing the horizontal coordinates of the position
+        , gcvec :: Vector3d -- ^ vector representing the geocentric coordinates of the position (metres)
+        , model :: !a -- ^ model (e.g. WGS84)
+        }
+
+instance (Model a) => Show (Position a) where
+    show p = showLatLong (latitude p, longitude p) ++ " " ++ (show . height $ p) ++ " (" ++ (show . model $ p) ++ ")"
+
+instance (Model a) => Eq (Position a)
+    -- model equality is ensure by @a@
+                                       where
+    p1 == p2 = latitude p1 == latitude p2 && longitude p1 == longitude p2 && height p1 == height p2
+
+-- | normal vector to the surface of a celestial body.
+--
+-- Orientation: z-axis points to the North Pole along the body's rotation axis,
+-- x-axis points towards the point where latitude = longitude = 0.
+data NVector =
+    NVector Double Double Double
+
+instance Show NVector where
+    show (NVector x y z) = "n-vector {" ++ show x ++ ", " ++ show y ++ ", " ++ show z ++ "}"
+
+-- | x-component of the given /n/-vector.
+nx :: NVector -> Double
+nx (NVector x _ _) = x
+
+-- | y-component of the given /n/-vector.
+ny :: NVector -> Double
+ny (NVector _ y _) = y
+
+-- | z-component of the given /n/-vector.
+nz :: NVector -> Double
+nz (NVector _ _ z) = z
+
+-- | Geocentric (cartesian) coordinates in the fixed-body coordinates system.
+--
+-- @x-y@ plane is the equatorial plane, @x@ is on the prime meridian, and @z@ on the polar axis.
+--
+-- On a spherical celestial body, an /n/-vector is equivalent to a normalised version of an
+-- geocentric cartesian coordinate.
+--
+-- Note: For Earth, this is known as the Earth-Centred Earth Fixed coordinates system (ECEF).
+--
+data Geocentric =
+    Geocentric Length Length Length
+
+instance Show Geocentric where
+    show (Geocentric x y z) = "geocentric {" ++ show x ++ ", " ++ show y ++ ", " ++ show z ++ "}"
+
+-- | x-coordinate of the given 'Geocentric' coordinates.
+gx :: Geocentric -> Length
+gx (Geocentric x _ _) = x
+
+-- | y-coordinate of the given 'Geocentric' coordinates.
+gy :: Geocentric -> Length
+gy (Geocentric _ y _) = y
+
+-- | z-coordinate of the given 'Geocentric' coordinates.
+gz :: Geocentric -> Length
+gz (Geocentric _ _ z) = z
+
+-- | @antipode p@ computes the antipodal position of @p@: the position which is diametrically
+-- opposite to @p@.
+antipode :: (Model a) => Position a -> Position a
+antipode p = nvh nv h (model p)
+  where
+    h = height p
+    nv = vscale (nvec p) (-1.0)
+
+-- | @nvector p@ returns the horizontal position of @p@ as a /n/-vector.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> nvector (northPole S84)
+-- n-vector {0.0, 0.0, 1.0}
+--
+-- >>> nvector (wgs84Pos 54 154 (metres 1000))
+-- n-vector {-0.5282978852629286, 0.2576680951131586, 0.8090169943749475}
+--
+nvector :: (Model a) => Position a -> NVector
+nvector p = NVector x y z
+  where
+    (Vector3d x y z) = nvec p
+
+-- | @geocentric p@ returns the 'Geocentric' coordinates of position @p@.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> geocentric (wgs84Pos 54 154 (metres 1000))
+-- geocentric {-3377.4908375km, 1647.312349km, 5137.5528484km}
+--
+geocentric :: (Model a) => Position a -> Geocentric
+geocentric p = Geocentric (metres x) (metres y) (metres z)
+  where
+    (Vector3d x y z) = gcvec p
+
+-- | Horizontal position of the North Pole in the given model.
+northPole :: (Model a) => a -> Position a
+northPole = nvh nvNorthPole zero
+
+-- | Horizontal position of the South Pole in the given model.
+southPole :: (Model a) => a -> Position a
+southPole = nvh nvSouthPole zero
+
+-- | Horizontal position of the North Pole (/n/-vector).
+nvNorthPole :: Vector3d
+nvNorthPole = Vector3d 0.0 0.0 1.0
+
+-- | Horizontal position of the South Pole (/n/-vector).
+nvSouthPole :: Vector3d
+nvSouthPole = Vector3d 0.0 0.0 (-1.0)
+
+-- | Reads a 'Position' from the given string using 'positionP'.
+readPosition :: (Model a) => String -> a -> Maybe (Position a)
+readPosition s m =
+    case map fst $ filter (null . snd) $ readP_to_S (positionP m) s of
+        [] -> Nothing
+        p:_ -> Just p
+
+-- | Parses and returns a 'Position'.
+--
+-- Supported formats:
+--
+--     * DD(MM)(SS)[N|S]DDD(MM)(SS)[E|W] - e.g. 553621N0130002E or 0116S03649E or 47N122W
+--
+--     * 'Angle'[N|S] 'Angle'[E|W] - e.g. 55°36'21''N 13°0'02''E or 11°16'S 36°49'E or 47°N 122°W
+--
+-- Additionally the string may end by a valid 'Length'.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>>
+-- >>> readPosition "55°36'21''N 013°00'02''E" WGS84
+-- Just 55°36'21.000"N,13°0'2.000"E 0.0m (WGS84)
+-- >>>
+-- >>> readPosition "55°36'21''N 013°00'02''E 1500m" WGS84
+-- Just 55°36'21.000"N,13°0'2.000"E 1500.0m (WGS84)
+--
+positionP :: (Model a) => a -> ReadP (Position a)
+positionP m = do
+    (lat, lon) <- latLongDmsP m
+    skipSpaces
+    h <- option zero lengthP
+    return (latLongHeightPos' lat lon h m)
+
+-- | Ground 'Position' from given geodetic latitude & longitude in __decimal degrees__ in
+-- the given model.
+--
+-- Latitude & longitude values are first converted to 'Angle' to ensure a consistent resolution
+-- with the rest of the API, then wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos' lat lon zero model
+-- @
+--
+latLongPos :: (Model a) => Double -> Double -> a -> Position a
+latLongPos lat lon = latLongHeightPos lat lon zero
+
+-- | 'Position' from given geodetic latitude & longitude in __decimal degrees__ and height
+-- in the given model
+--
+-- Latitude & longitude values are first converted to 'Angle' to ensure a consistent resolution
+-- with the rest of the API, then wrapped to their respective range.
+--
+latLongHeightPos :: (Model a) => Double -> Double -> Length -> a -> Position a
+latLongHeightPos lat lon = latLongHeightPos' (decimalDegrees lat) (decimalDegrees lon)
+
+-- | Ground 'Position' from given geodetic latitude & longitude in
+-- the given model.
+-- Latitude & longitude values are wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos'' lat lon zero model
+-- @
+--
+latLongPos' :: (Model a) => Angle -> Angle -> a -> Position a
+latLongPos' lat lon = latLongHeightPos' lat lon zero
+
+-- | 'Position' from given geodetic latitude & longitude and height in the given model.
+-- Latitude & longitude values are wrapped to their respective range.
+latLongHeightPos' :: (Model a) => Angle -> Angle -> Length -> a -> Position a
+latLongHeightPos' lat lon h m = Position lat' lon' h nv g m
+  where
+    nv = nvectorFromLatLong (lat, lon)
+    g = nvectorToGeocentric (nv, h) (surface m)
+    (lat', lon') = wrap lat lon nv m
+
+-- | 'Position' from given geodetic latitude & longitude in __decimal degrees__ and height in
+-- the WGS84 datum.
+--
+-- Latitude & longitude values are first converted to 'Angle' to ensure a consistent resolution
+-- with the rest of the API, then wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos' lat lon h 'WGS84'
+-- @
+--
+wgs84Pos :: Double -> Double -> Length -> Position WGS84
+wgs84Pos lat lon h = latLongHeightPos lat lon h WGS84
+
+-- | 'Position' from given geodetic latitude & longitude and height in the WGS84 datum.
+-- Latitude & longitude values are wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos'' lat lon h 'WGS84'
+-- @
+--
+wgs84Pos' :: Angle -> Angle -> Length -> Position WGS84
+wgs84Pos' lat lon h = latLongHeightPos' lat lon h WGS84
+
+-- | 'Position' from given latitude & longitude in __decimal degrees__ and height in the
+-- spherical datum derived from WGS84.
+--
+-- Latitude & longitude values are first converted to 'Angle' to ensure a consistent resolution
+-- with the rest of the API, then wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos' lat lon h 'S84'
+-- @
+--
+s84Pos :: Double -> Double -> Length -> Position S84
+s84Pos lat lon h = latLongHeightPos lat lon h S84
+
+-- | 'Position' from given latitude & longitude and height in the spherical datum derived
+-- from WGS84. Latitude & longitude values are wrapped to their respective range.
+--
+-- This is equivalent to:
+--
+-- @
+--     'latLongHeightPos'' lat lon h 'S84'
+-- @
+--
+s84Pos' :: Angle -> Angle -> Length -> Position S84
+s84Pos' lat lon h = latLongHeightPos' lat lon h S84
+
+-- | 'Position' from given geocentric coordinates x, y and z in the given model.
+geocentricPos :: (Model a) => Length -> Length -> Length -> a -> Position a
+geocentricPos x y z = geocentricMetresPos' (toMetres x) (toMetres y) (toMetres z)
+
+-- | 'Position' from given geocentric coordinates x, y and z in __metres__ in the given model.
+--
+-- x, y, z lengths are first converted to 'Length' to ensure a consistent resolution with the rest of the API.
+geocentricMetresPos :: (Model a) => Double -> Double -> Double -> a -> Position a
+geocentricMetresPos x y z = geocentricMetresPos' (toMetres . metres $ x) (toMetres . metres $ y) (toMetres . metres $ z)
+
+geocentricMetresPos' :: (Model a) => Double -> Double -> Double -> a -> Position a
+geocentricMetresPos' x y z m = Position lat lon h nv ev m
+  where
+    ev = Vector3d x y z
+    (nv, h) = nvectorFromGeocentric ev (surface m)
+    (lat, lon) = nvectorToLatLong nv
+
+-- | 'Position' from given /n/-vector x, y, z coordinates in the given model.
+-- Vector (x, y, z) will be normalised to a unit vector to get a valid /n/-vector.
+--
+-- This is equivalent to:
+--
+-- @
+--     'nvectorHeightPos' lat lon zero model
+-- @
+--
+nvectorPos :: (Model a) => Double -> Double -> Double -> a -> Position a
+nvectorPos x y z = nvectorHeightPos x y z zero
+
+-- | 'Position' from given /n/-vector x, y, z coordinates and height in the given model.
+-- Vector (x, y, z) will be normalised to a unit vector to get a valid /n/-vector.
+nvectorHeightPos :: (Model a) => Double -> Double -> Double -> Length -> a -> Position a
+nvectorHeightPos x y z = nvh (vunit (Vector3d x y z))
+
+-- | (latitude, longitude) pair in __decimal degrees__ from given position.
+latLong :: (Model a) => Position a -> (Double, Double)
+latLong p = (toDecimalDegrees . latitude $ p, toDecimalDegrees . longitude $ p)
+
+-- | (latitude, longitude) pair from given position.
+latLong' :: (Model a) => Position a -> (Angle, Angle)
+latLong' p = (latitude p, longitude p)
+ -- given 'Vector3d' is a /n/-vector.
+
+-- | position from /n/-vector, height and model; this method is to be used only if
+nvh :: (Model a) => Vector3d -> Length -> a -> Position a
+nvh nv h m = Position lat lon h nv g m
+  where
+    (lat, lon) = llWrapped nv (longitudeRange m)
+    g = nvectorToGeocentric (nv, h) (surface m)
+
+-- | @nvectorToLatLong nv@ returns (latitude, longitude) pair equivalent to the given /n/-vector @nv@.
+--
+-- You should prefer using:
+--
+-- @
+--     'latLong' ('nvectorPos' x y z model)
+-- @
+--
+-- Latitude is always in [-90°, 90°] and longitude in [-180°, 180°].
+nvectorToLatLong :: Vector3d -> (Angle, Angle)
+nvectorToLatLong nv = (lat, lon)
+  where
+    lat = atan2' (vz nv) (sqrt (vx nv * vx nv + vy nv * vy nv))
+    lon = atan2' (vy nv) (vx nv)
+
+-- | @nvectorFromLatLong ll@ returns /n/-vector equivalent to the given (latitude, longitude) pair @ll@.
+--
+-- You should prefer using:
+--
+-- @
+--     'nvector' ('latLongPos' lat lon model)
+-- @
+nvectorFromLatLong :: (Angle, Angle) -> Vector3d
+nvectorFromLatLong (lat, lon) = Vector3d x y z
+  where
+    cl = cos' lat
+    x = cl * cos' lon
+    y = cl * sin' lon
+    z = sin' lat
+
+-- | @nvectorToGeocentric (nv, h) e@ returns the geocentric coordinates equivalent to the given
+-- /n/-vector @nv@ and height @h@ using the ellispoid @e@.
+--
+-- You should prefer using:
+--
+-- @
+--     'geocentric' ('nvectorHeightPos' x y z h model)
+-- @
+--
+nvectorToGeocentric :: (Vector3d, Length) -> Ellipsoid -> Vector3d
+nvectorToGeocentric (nv, h) e
+    | isSphere e = nvectorToGeocentricS (nv, h) (equatorialRadius e)
+    | otherwise = nvectorToGeocentricE (nv, h) e
+
+nvectorToGeocentricS :: (Vector3d, Length) -> Length -> Vector3d
+nvectorToGeocentricS (nv, h) r = vscale nv (toMetres n)
+  where
+    n = add h r
+
+nvectorToGeocentricE :: (Vector3d, Length) -> Ellipsoid -> Vector3d
+nvectorToGeocentricE (nv, h) e = Vector3d gx' gy' gz'
+  where
+    a = toMetres . equatorialRadius $ e
+    b = toMetres . polarRadius $ e
+    nx' = vx nv
+    ny' = vy nv
+    nz' = vz nv
+    m = (a * a) / (b * b)
+    n = b / sqrt ((nx' * nx' * m) + (ny' * ny' * m) + (nz' * nz'))
+    h' = toMetres h
+    gx' = n * m * nx' + h' * nx'
+    gy' = n * m * ny' + h' * ny'
+    gz' = n * nz' + h' * nz'
+
+-- | @nvectorFromGeocentric g e@ returns the /n/-vector equivalent to the geocentric
+-- coordinates @g@ using the ellispoid @e@.
+--
+-- You should prefer using:
+--
+-- @
+--     'nvector' ('geocentricMetresPos' x y z model)
+-- @
+--
+nvectorFromGeocentric :: Vector3d -> Ellipsoid -> (Vector3d, Length)
+nvectorFromGeocentric g e
+    | isSphere e = nvectorFromGeocentricS g (equatorialRadius e)
+    | otherwise = nvectorFromGeocentricE g e
+
+nvectorFromGeocentricS :: Vector3d -> Length -> (Vector3d, Length)
+nvectorFromGeocentricS g r = (vunit g, h)
+  where
+    h = sub (metres (vnorm g)) r
+
+nvectorFromGeocentricE :: Vector3d -> Ellipsoid -> (Vector3d, Length)
+nvectorFromGeocentricE g e = (nvecEllipsoidal d e2 k px py pz, metres h)
+  where
+    e' = eccentricity e
+    e2 = e' * e'
+    e4 = e2 * e2
+    a = toMetres . equatorialRadius $ e
+    a2 = a * a
+    px = vx g
+    py = vy g
+    pz = vz g
+    p = (px * px + py * py) / a2
+    q = ((1 - e2) / a2) * (pz * pz)
+    r = (p + q - e4) / 6.0
+    s = (e4 * p * q) / (4.0 * r * r * r)
+    t = (1.0 + s + sqrt (s * (2.0 + s))) ** (1 / 3)
+    u = r * (1.0 + t + 1.0 / t)
+    v = sqrt (u * u + q * e4)
+    w = e2 * (u + v - q) / (2.0 * v)
+    k = sqrt (u + v + w * w) - w
+    d = k * sqrt (px * px + py * py) / (k + e2)
+    h = ((k + e2 - 1.0) / k) * sqrt (d * d + pz * pz)
+
+nvecEllipsoidal :: Double -> Double -> Double -> Double -> Double -> Double -> Vector3d
+nvecEllipsoidal d e2 k px py pz = Vector3d nx' ny' nz'
+  where
+    s = 1.0 / sqrt (d * d + pz * pz)
+    a = k / (k + e2)
+    nx' = s * a * px
+    ny' = s * a * py
+    nz' = s * pz
+
+wrap :: (Model a) => Angle -> Angle -> Vector3d -> a -> (Angle, Angle)
+wrap lat lon nv m =
+    if isValidLatLong lat lon m
+        then (lat, lon)
+        else llWrapped nv (longitudeRange m)
+
+llWrapped :: Vector3d -> LongitudeRange -> (Angle, Angle)
+llWrapped nv lr = (lat, lon')
+  where
+    (lat, lon) = nvectorToLatLong nv
+    lon' =
+        case lr of
+            L180 -> lon
+            L360 -> add lon (decimalDegrees 180)
src/Data/Geo/Jord/Quantity.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Quantity
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -13,6 +13,8 @@     ) where
 
 -- | Something that can be added or subtracted.
-class (Eq a) => Quantity a where
+class (Eq a, Ord a) =>
+      Quantity a
+    where
     add, sub :: a -> a -> a
     zero :: a
src/Data/Geo/Jord/Rotation.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Rotation
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -135,4 +135,4 @@     sz = sin' z
     v1 = Vector3d (cz * cy) ((-sz) * cx + cz * sy * sx) (sz * sx + cz * sy * cx)
     v2 = Vector3d (sz * cy) (cz * cx + sz * sy * sx) ((-cz) * sx + sz * sy * cx)
-    v3 = Vector3d (-sy) (cy * sx) (cy * cx)
+    v3 = Vector3d (-sy) (cy * sx) (cy * cx)
src/Data/Geo/Jord/Speed.hs view
@@ -1,6 +1,6 @@ -- |
 -- Module:      Data.Geo.Jord.Speed
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
@@ -13,15 +13,15 @@     -- * The 'Speed' type
       Speed
     -- * Smart constructors
+    , averageSpeed
     , metresPerSecond
     , kilometresPerHour
     , milesPerHour
     , knots
     , feetPerSecond
     -- * Read
+    , speedP
     , readSpeed
-    , readSpeedE
-    , readSpeedF
     -- * Conversions
     , toMetresPerSecond
     , toKilometresPerHour
@@ -30,33 +30,46 @@     , toFeetPerSecond
     ) where
 
-import Control.Applicative
-import Control.Monad.Fail
+import Control.Applicative ((<|>))
+import Text.ParserCombinators.ReadP (ReadP, pfail, readP_to_S, skipSpaces, string)
+import Text.Read (readMaybe)
+
+import Data.Geo.Jord.Duration
+import Data.Geo.Jord.Length
 import Data.Geo.Jord.Parser
 import Data.Geo.Jord.Quantity
-import Prelude hiding (fail)
-import Text.ParserCombinators.ReadP
-import Text.Read hiding (pfail)
 
 -- | A speed with a resolution of 1 millimetre per hour.
-newtype Speed = Speed
-    { mmPerHour :: Int
-    } deriving (Eq)
+newtype Speed =
+    Speed
+        { mmPerHour :: Int
+        }
+    deriving (Eq)
 
--- | See 'readSpeed'.
+-- | See 'speedP'.
 instance Read Speed where
-    readsPrec _ = readP_to_S speed
+    readsPrec _ = readP_to_S speedP
 
 -- | Speed is shown in kilometres per hour.
 instance Show Speed where
     show s = show (toKilometresPerHour s) ++ "km/h"
 
+instance Ord Speed where
+    (<=) (Speed s1) (Speed s2) = s1 <= s2
+
 -- | Add/Subtract Speed.
 instance Quantity Speed where
     add a b = Speed (mmPerHour a + mmPerHour b)
     sub a b = Speed (mmPerHour a - mmPerHour b)
     zero = Speed 0
 
+-- | 'Speed' from covered distance and duration.
+averageSpeed :: Length -> Duration -> Speed
+averageSpeed d t = Speed (round (mm / h))
+  where
+    mm = toMillimetres d
+    h = toHours t
+
 -- | 'Speed' from given amount of metres per second.
 metresPerSecond :: Double -> Speed
 metresPerSecond mps = Speed (round (mps * 3600000.0))
@@ -77,27 +90,9 @@ feetPerSecond :: Double -> Speed
 feetPerSecond fps = Speed (round (fps * 1097280.0))
 
--- | Obtains a 'Speed' from the given string formatted as (-)float[m/s|km/h|mph|kt] - e.g. 300m/s, 250km/h, -154mph, 400kt or 100ft/s.
---
--- This simply calls @read s :: Speed@ so 'error' should be handled at the call site.
---
-readSpeed :: String -> Speed
-readSpeed s = read s :: Speed
-
--- | Same as 'readSpeed' but returns a 'Either'.
-readSpeedE :: String -> Either String Speed
-readSpeedE s =
-    case readMaybe s of
-        Nothing -> Left ("couldn't read speed " ++ s)
-        Just l -> Right l
-
--- | Same as 'readSpeed' but returns a 'MonadFail'.
-readSpeedF :: (MonadFail m) => String -> m Speed
-readSpeedF s =
-    let p = readEither s
-     in case p of
-            Left e -> fail e
-            Right l -> return l
+-- | Reads an a 'Speed' from the given string using 'speedP'.
+readSpeed :: String -> Maybe Speed
+readSpeed s = readMaybe s :: (Maybe Speed)
 
 -- | @toMetresPerSecond s@ converts @s@ to metres per second.
 toMetresPerSecond :: Speed -> Double
@@ -119,9 +114,10 @@ toFeetPerSecond :: Speed -> Double
 toFeetPerSecond (Speed s) = fromIntegral s / 1097280.0
 
--- | Parses and returns a 'Speed'.
-speed :: ReadP Speed
-speed = do
+-- | Parses and returns a 'Speed' formatted as (-)float[m/s|km/h|mph|kt].
+-- e.g. 300m/s, 250km/h, -154mph, 400kt or 100ft/s.
+speedP :: ReadP Speed
+speedP = do
     s <- number
     skipSpaces
     u <- string "m/s" <|> string "km/h" <|> string "mph" <|> string "kt" <|> string "ft/s"
src/Data/Geo/Jord/Transformation.hs view
@@ -1,192 +1,136 @@-{-# LANGUAGE FlexibleInstances #-}- -- |
 -- Module:      Data.Geo.Jord.Transformation
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
 -- Portability: portable
 --
--- Transformations between coordinates systems both in spherical and ellipsoidal form.
+-- Coordinates transformation between ellipsoidal models.
 --
--- All functions are implemented using the vector-based approached described in
--- <http://www.navlab.net/Publications/A_Nonsingular_Horizontal_Position_Representation.pdf Gade, K. (2010). A Non-singular Horizontal Position Representation>
+-- In order to use this module you should start with the following imports:
 --
--- See <http://clynchg3c.com/Technote/geodesy/coorddef.pdf Earth Coordinates>
+-- @
+--     import Data.Geo.Jord.Position
+--     import Data.Geo.Jord.Transformation
+-- @
 --
-module Data.Geo.Jord.Transformation-    ( NTransform(..)-    , ETransform(..)-    , nvectorToLatLong-    , latLongToNVector-    , ecefToNVector-    , nvectorToEcef-    , geodeticHeight-    ) where--import Data.Geo.Jord.Angle-import Data.Geo.Jord.AngularPosition-import Data.Geo.Jord.Earth-import Data.Geo.Jord.EcefPosition-import Data.Geo.Jord.LatLong-import Data.Geo.Jord.Length-import Data.Geo.Jord.NVector-import Data.Geo.Jord.Quantity-import Data.Geo.Jord.Vector3d---- | Transformation between position and /n/-vector and height.
-class NTransform a where-    toNVector :: a -> AngularPosition NVector -- ^ data to 'AngularPosition' of 'NVector'.
-    fromNVector :: AngularPosition NVector -> a -- ^ 'AngularPosition' of 'NVector' and height to position.
---- | 'NVector' to, from 'AngularPosition' of 'NVector'.
-instance NTransform NVector where-    toNVector nv = AngularPosition nv zero-    fromNVector = pos---- | 'LatLong' to, from 'AngularPosition' of 'NVector'.
-instance NTransform LatLong where-    toNVector ll = AngularPosition (latLongToNVector ll) zero-    fromNVector = nvectorToLatLong . pos---- | 'NTransform' identity.
-instance NTransform (AngularPosition NVector) where-    toNVector = id-    fromNVector = id+--
+module Data.Geo.Jord.Transformation
+    ( transformCoords
+    , transformCoords'
+    , transformCoordsAt
+    , transformCoordsAt'
+    -- * re-exported for convenience
+    , module Data.Geo.Jord.Tx
+    , module Data.Geo.Jord.Txs
+    ) where
 
--- | 'AngularPosition' of 'LatLong' to, from 'AngularPosition' of 'NVector'.
-instance NTransform (AngularPosition LatLong) where-    toNVector (AngularPosition ll h) = AngularPosition (latLongToNVector ll) h-    fromNVector (AngularPosition nv h) = AngularPosition (nvectorToLatLong nv) h---- | Transformation between 'EcefPosition' and angular or /n/-vector positions.
-class ETransform a where-    toEcef :: a -> Earth -> EcefPosition -- ^ position and earth model to to 'EcefPosition'.
-    fromEcef :: EcefPosition -> Earth -> a -- ^ 'EcefPosition' and earth model to position.
---- | 'NVector' to, from 'EcefPosition'.
-instance ETransform NVector where-    fromEcef p e = pos (ecefToNVector p e)-    toEcef v = nvectorToEcef (nvectorHeight v zero)---- | 'LatLong' to, from 'EcefPosition'.
-instance ETransform LatLong where-    fromEcef p e = fromNVector (nvectorHeight (fromEcef p e :: NVector) zero)-    toEcef = toEcef . toNVector---- | 'AngularPosition' of 'NVector' to, from 'EcefPosition'.
-instance ETransform (AngularPosition NVector) where-    fromEcef = ecefToNVector-    toEcef = nvectorToEcef---- | 'AngularPosition' of 'LatLong' to, from 'EcefPosition'.
-instance ETransform (AngularPosition LatLong) where-    fromEcef p e = fromNVector (ecefToNVector p e)-    toEcef = nvectorToEcef . toNVector---- | 'ETransform' identity.
-instance ETransform EcefPosition where-    fromEcef p _ = p-    toEcef p _ = p---- | @nvectorToLatLong v@ transforms 'NVector' @v@ to an equivalent 'LatLong'.
+import Data.Geo.Jord.Position
+import Data.Geo.Jord.Tx
+import Data.Geo.Jord.Txs
+
+-- | @transformCoords 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@ - see 'txParamsBetween'.
 --
--- See also 'toNVector'.
-nvectorToLatLong :: NVector -> LatLong-nvectorToLatLong nv = latLong lat lon-  where-    v = vec nv-    lat = atan2' (vz v) (sqrt (vx v * vx v + vy v * vy v))-    lon = atan2' (vy v) (vx v)---- | @latLongToNVector ll@ transforms 'LatLong' @ll@ to an equivalent 'NVector'.
+-- ==== __Examples__
 --
--- See also 'fromNVector'.
-latLongToNVector :: LatLong -> NVector-latLongToNVector ll = nvector x' y' z'-  where-    lat = latitude ll-    lon = longitude ll-    cl = cos' lat-    x' = cl * cos' lon-    y' = cl * sin' lon-    z' = sin' lat---- | @ecefToNVector p e@ transforms 'EcefPosition' @p@ to an equivalent 'NVector' and geodetic height
--- using earth model @e@.
+-- >>> import Data.Geo.Jord.Position
+-- >>> import Data.Geo.Jord.Transformation
+-- >>>
+-- >>> let pWGS84 = wgs84Pos 48.6921 6.1844 (metres 188)
+-- >>> transformCoords pWGS84 NAD83 staticTxs
+-- Just 48°41'31.523"N,6°11'3.723"E 188.1212m (NAD83)
 --
--- See also 'fromEcef'
-ecefToNVector :: EcefPosition -> Earth -> AngularPosition NVector--- Ellipsoidal
-ecefToNVector ep e@(Ellipsoidal el) = nvectorHeight (nvecEllipsoidal d e2 k px py pz) (metres h)-  where-    ev = vec ep-    e' = eccentricity e-    e2 = e' * e'-    e4 = e2 * e2-    a = toMetres (equatorialRadius el)-    a2 = a * a-    px = vx ev-    py = vy ev-    pz = vz ev-    p = (px * px + py * py) / a2-    q = ((1 - e2) / a2) * (pz * pz)-    r = (p + q - e4) / 6.0-    s = (e4 * p * q) / (4.0 * r * r * r)-    t = (1.0 + s + sqrt (s * (2.0 + s))) ** (1 / 3)-    u = r * (1.0 + t + 1.0 / t)-    v = sqrt (u * u + q * e4)-    w = e2 * (u + v - q) / (2.0 * v)-    k = sqrt (u + v + w * w) - w-    d = k * sqrt (px * px + py * py) / (k + e2)-    h = ((k + e2 - 1.0) / k) * sqrt (d * d + pz * pz)--- Spherical
-ecefToNVector p (Spherical r) = nvectorHeight (nvector (vx nv) (vy nv) (vz nv)) h-  where-    ev = vec p-    nv = vunit ev-    h = sub (metres (vnorm ev)) r--nvecEllipsoidal :: Double -> Double -> Double -> Double -> Double -> Double -> NVector-nvecEllipsoidal d e2 k px py pz = nvector nx' ny' nz'-  where-    s = 1.0 / sqrt (d * d + pz * pz)-    a = k / (k + e2)-    nx' = s * a * px-    ny' = s * a * py-    nz' = s * pz---- | @nvectorToEcef (n, h) e@ transforms 'NVector' @n@ and geodetic height @h@
--- to an equivalent 'EcefPosition' using earth model @e@.
+transformCoords ::
+       (Ellipsoidal a, Ellipsoidal b) => Position a -> b -> TxGraph TxParams7 -> Maybe (Position b)
+transformCoords p1 m2 g = transformCoordsF p1 m2 g id
+
+-- | @transformCoords' 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@.
 --
--- See also 'toEcef'
-nvectorToEcef :: AngularPosition NVector -> Earth -> EcefPosition--- Ellipsoidal
-nvectorToEcef (AngularPosition nv h) e@(Ellipsoidal el) = ecef ex' ey' ez'-  where-    v = vec nv-    uv = vunit v-    a = toMetres (equatorialRadius el)-    b = toMetres (polarRadius e)-    nx' = vx uv-    ny' = vy uv-    nz' = vz uv-    m = (a * a) / (b * b)-    n = b / sqrt ((nx' * nx' * m) + (ny' * ny' * m) + (nz' * nz'))-    h' = toMetres h-    ex' = metres (n * m * nx' + h' * nx')-    ey' = metres (n * m * ny' + h' * ny')-    ez' = metres (n * nz' + h' * nz')--- Spherical
-nvectorToEcef (AngularPosition nv h) (Spherical r) = ecefMetres (vx ev) (vy ev) (vz ev)-  where-    unv = vunit . vec $ nv-    n = add h r-    ev = vscale unv (toMetres n)---- | @geodeticHeight p e@ computes the geodetic height of 'EcefPosition' @p@ using earth model @e@.
+-- Notes: this function does not checks whether both models are equals. It should be used when the
+-- 7-parameter transformation is known. Most of the time prefer using 'transformCoords'.
 --
--- The geodetic height (or ellipsoidal height) is __not__ the mean sea level (MSL) height.
-geodeticHeight :: EcefPosition -> Earth -> Length-geodeticHeight p e = height (ecefToNVector p e)+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>> import Data.Geo.Jord.Transformation
+-- >>>
+-- >>> let tx = txParams7 (995.6, -1910.3, -521.5) (-0.62) (25.915, 9.426, 11.599) -- WGS84 -> NAD83
+-- >>> let pWGS84 = wgs84Pos 48.6921 6.1844 (metres 188)
+-- >>> transformCoords' pWGS84 NAD83 tx
+-- 48°41'31.523"N,6°11'3.723"E 188.1212m (NAD83)
+--
+transformCoords' :: (Ellipsoidal a, Ellipsoidal b) => Position a -> b -> TxParams7 -> Position b
+transformCoords' = transformPosCoords
+
+-- | @transformCoordsAt 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@ - see 'txParamsBetween'.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>> import Data.Geo.Jord.Transformation
+-- >>>
+-- >>> let pITRF2014 = latLongHeightPos 48.6921 6.1844 (metres 188) ITRF2014
+-- >>> transformCoordsAt pITRF2014 (Epoch 2019.0) NAD83_CORS96 dynamicTxs -- through ITRF2000
+-- Just 48°41'31.538"N,6°11'3.722"E 188.112035m (NAD83_CORS96)
+--
+transformCoordsAt ::
+       (EllipsoidalT0 a, EllipsoidalT0 b)
+    => Position a
+    -> Epoch
+    -> b
+    -> TxGraph TxParams15
+    -> Maybe (Position b)
+transformCoordsAt p1 e m2 g = transformCoordsF p1 m2 g (txParamsAt e)
+
+-- | @transformCoordsAt' 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@.
+--
+-- Notes: this function does not checks whether both models are equals. It should be used when the
+-- 15-parameter transformation is known. Most of the time prefer using 'transformCoords'.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.Geo.Jord.Position
+-- >>> import Data.Geo.Jord.Transformation
+-- >>>
+-- >>> let tx7 = txParams7 (53.7, 51.2, -55.1) 1.2 (0.891, 5.39, -8.712)
+-- >>> let txR = txRates (0.1, 0.1, -1.9) 0.11 (0.81, 0.49, -0.792)
+-- >>> let tx = TxParams15 (Epoch 2000.0) tx7 txR -- ITRF2014 -> ETRF2000
+-- >>> let pITRF2014 = latLongHeightPos 48.6921 6.1844 (metres 188) ITRF2014
+-- >>> transformCoordsAt' pITRF2014 (Epoch 2019.0) ETRF2000 tx
+-- 48°41'31.561"N,6°11'3.865"E 188.0178m (ETRF2000)
+--
+transformCoordsAt' ::
+       (EllipsoidalT0 a, EllipsoidalT0 b) => Position a -> Epoch -> b -> TxParams15 -> Position b
+transformCoordsAt' p1 e m2 ps = transformPosCoords p1 m2 (txParamsAt e ps)
+
+transformCoordsF ::
+       (Ellipsoidal a, Ellipsoidal b, TxParams p)
+    => Position a
+    -> b
+    -> TxGraph p
+    -> (p -> TxParams7)
+    -> Maybe (Position b)
+transformCoordsF p1 m2 g f =
+    case ps of
+        [] -> Nothing
+        _ -> Just (geocentricMetresPos v2x v2y v2z m2)
+  where
+    mi1 = modelId . model $ p1
+    mi2 = modelId m2
+    ps = txParamsBetween mi1 mi2 g
+    (Vector3d v2x v2y v2z) = foldl (\gc p -> transformGeoc gc (f p)) (gcvec p1) ps
+
+transformPosCoords :: (Model a, Model b) => Position a -> b -> TxParams7 -> Position b
+transformPosCoords p1 m2 ps = geocentricMetresPos v2x v2y v2z m2
+  where
+    (Vector3d v2x v2y v2z) = transformGeoc (gcvec p1) ps
+ src/Data/Geo/Jord/Tx.hs view
@@ -0,0 +1,236 @@+-- |
+-- Module:      Data.Geo.Jord.Transformation
+-- Copyright:   (c) 2020 Cedric Liegeois
+-- License:     BSD3
+-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Coordinates transformation parameters.
+--
+module Data.Geo.Jord.Tx
+    (
+    -- * transformation parameters.
+      Tx(..)
+    , inverseTx
+    , TxParams(..)
+    , TxParams7
+    , TxRates
+    , TxParams15(..)
+    , txParams7
+    , txRates
+    , txParamsAt
+    -- * transformation graph.
+    , TxGraph
+    , txGraph
+    , txParamsBetween
+    -- * geocentric coordinate transformation
+    , transformGeoc
+    ) where
+
+import Data.List (find, foldl', sortOn)
+import Data.Maybe (mapMaybe)
+
+import Data.Geo.Jord.Model
+import Data.Geo.Jord.Vector3d
+
+-- | Coordinate transformation between 2 models (A & B).
+data Tx a =
+    Tx
+        { modelA :: ModelId -- ^  model A.
+        , modelB :: ModelId -- ^ model B.
+        , txParams :: a -- ^ transformation parameters - i.e. 'modelA'-> 'modelB'
+        }
+
+-- | inverse transformation.
+inverseTx :: (TxParams a) => Tx a -> Tx a
+inverseTx t = Tx (modelB t) (modelA t) (inverseTxParams (txParams t))
+
+-- | class for transformation parameters.
+class TxParams a where
+    idTxParams :: a -- ^ identity transformation parameters, i.e. @p T idTxParams = p@.
+    inverseTxParams :: a -> a -- ^ inverse transformation parameters.
+
+-- | 7-parameter transformation (Helmert); use 'txParams7' to construct.
+data TxParams7 =
+    TxParams7 !Vector3d !Double !Vector3d
+    deriving (Show)
+
+instance TxParams TxParams7 where
+    idTxParams = TxParams7 (Vector3d 0 0 0) 0 (Vector3d 0 0 0)
+    inverseTxParams (TxParams7 c s r) = TxParams7 (vscale c (-1.0)) (-s) (vscale r (-1.0))
+
+instance TxParams TxParams15 where
+    idTxParams = TxParams15 (Epoch 0) idTxParams (TxRates (Vector3d 0 0 0) 0 (Vector3d 0 0 0))
+    inverseTxParams (TxParams15 e p (TxRates c s r)) =
+        TxParams15 e (inverseTxParams p) (TxRates (vscale c (-1.0)) (-s) (vscale r (-1.0)))
+
+-- | Transformation rates for the 15-parameter transformation (Helmert); use 'txRates' to construct.
+data TxRates =
+    TxRates !Vector3d !Double !Vector3d
+    deriving (Show)
+
+-- | Epoch and 14-parameter transformation (Helmert).
+data TxParams15 =
+    TxParams15 Epoch TxParams7 TxRates
+    deriving (Show)
+
+-- | 7-parameter transformation (Helmert) from given translation vector, scale factor and rotation matrix.
+txParams7 ::
+       (Double, Double, Double) -- ^ translation vector containing the three translations along the coordinate axes: tx, ty, tz in __millimetres__
+    -> Double -- ^ scale factor (unitless) expressed in __parts per billion__
+    -> (Double, Double, Double) -- ^ rotation matrix (orthogonal) consisting of the three axes rx, ry, rz in __milliarcseconds__
+    -> TxParams7
+txParams7 c s r = TxParams7 (mmToMetres c) (s / 1e9) (masToRadians r)
+
+-- | rates of the 15-parameter translation (Helmert) from given translation rates, scale factor rate and rotation rates.
+txRates ::
+       (Double, Double, Double) -- ^ translation rate in __millimetres per year__.
+    -> Double -- ^ scale factor rate in __part per billion per year__.
+    -> (Double, Double, Double) -- ^ rotation rate in __milliarcseconds per year__.
+    -> TxRates
+txRates c s r = TxRates (mmToMetres c) (s / 1e9) (masToRadians r)
+
+mmToMetres :: (Double, Double, Double) -> Vector3d
+mmToMetres (cx, cy, cz) = vscale (Vector3d cx cy cz) (1.0 / 1000.0)
+
+masToRadians :: (Double, Double, Double) -> Vector3d
+masToRadians (rx, ry, rz) = vscale (Vector3d rx ry rz) (pi / (3600.0 * 1000.0 * 180.0))
+
+-- | @txParamsAt e tx15@ returns the 7-parameter transformation corresponding to the
+-- 15-parameter transformation @tx15@ at epoch @e@.
+txParamsAt :: Epoch -> TxParams15 -> TxParams7
+txParamsAt (Epoch e) (TxParams15 (Epoch pe) (TxParams7 c s r) (TxRates rc rs rr)) =
+    TxParams7 c' s' r'
+  where
+    de = e - pe
+    c' = vadd c (vscale rc de)
+    s' = s + de * rs
+    r' = vadd r (vscale rr de)
+
+-- | node to adjacent nodes.
+data Connection =
+    Connection
+        { node :: !ModelId
+        , adjacents :: ![ModelId]
+        }
+
+-- | graph edge: from model, tx params, to model.
+data Edge a =
+    Edge ModelId a ModelId
+
+-- path of visited models.
+type Path = [ModelId]
+
+-- queued, visited.
+data State =
+    State [ModelId] [Path]
+
+-- | Transformation graph: vertices are 'ModelId' and edges are transformation parameters.
+data TxGraph a =
+    TxGraph ![Connection] ![Edge a]
+
+-- | @txGraph ts@ returns a transformation graph containing all given direct and inverse
+-- (i.e. for each 'Tx': 'txParams' & 'inverseTxParams') transformations.
+txGraph :: (TxParams a) => [Tx a] -> TxGraph a
+txGraph = foldl' addTx emptyGraph
+
+-- | @txParamsBetween m0 m1 g@ computes the ordered list of transformation parameters to be
+-- successively applied when transforming the coordinates of a position in model @m0@ to model @m1@.
+-- The returned list is empty, if either model is not in the graph (i.e. not a vertex)  or if no
+-- such transformation exists (i.e. model @m1@ cannot be reached from model @m0@).
+txParamsBetween :: (TxParams a) => ModelId -> ModelId -> TxGraph a -> [a]
+txParamsBetween m0 m1 g
+    | m0 == m1 = [idTxParams]
+    | null ms = []
+    | otherwise = findParams ms g
+  where
+    ms = dijkstra (State [m0] []) m1 g
+
+-- | empty graph.
+emptyGraph :: TxGraph a
+emptyGraph = TxGraph [] []
+
+-- | add 'Tx' to graph.
+addTx :: (TxParams a) => TxGraph a -> Tx a -> TxGraph a
+addTx (TxGraph cs es) t = TxGraph cs' es'
+  where
+    ma = modelA t
+    mb = modelB t
+    cs1 = addConnection cs ma mb
+    cs' = addConnection cs1 mb ma
+    txp = txParams t
+    es' = Edge ma txp mb : Edge mb (inverseTxParams txp) ma : es
+
+-- | add connection to graph.
+addConnection :: [Connection] -> ModelId -> ModelId -> [Connection]
+addConnection cs m1 m2
+    | null filtered = Connection m1 [m2] : cs
+    | otherwise =
+        map
+            (\c' ->
+                 if node c' == m1
+                     then updated
+                     else c')
+            cs
+  where
+    filtered = filter (\c -> node c == m1) cs
+    cur = head filtered
+    updated = cur {adjacents = m2 : adjacents cur}
+
+-- | successors of given model in given graph.
+successors :: ModelId -> TxGraph a -> [ModelId]
+successors m (TxGraph cs _) = concatMap adjacents (filter (\c -> node c == m) cs)
+
+-- | visit every given model from given model.
+visit :: ModelId -> [ModelId] -> State -> State
+visit f ms (State q0 v0) = State q1 v1
+  where
+    toVisit = filter (`notElem` concat v0) ms -- filter models already visited
+    fs = filter (\v -> head v == f) v0 -- all paths starting at f
+    q1 = q0 ++ toVisit
+    updatedPaths = concatMap (\x -> map (: x) toVisit) fs
+    v1 = updatedPaths ++ filter (\v -> head v /= f) v0
+
+shortest :: ModelId -> ModelId -> [Path] -> [ModelId]
+shortest c m ps = reverse (m : s)
+  where
+    fs = filter (\v -> head v == c) ps -- all paths starting at c
+    s = head (sortOn length fs)
+
+-- | dijkstra.
+dijkstra :: State -> ModelId -> TxGraph a -> [ModelId]
+dijkstra (State [] _) _ _ = []
+dijkstra (State [c] []) t g = dijkstra (State [c] [[c]]) t g
+dijkstra (State (c:r) v) t g
+    | t `elem` succs = shortest c t v
+    | otherwise = dijkstra s'' t g
+  where
+    s' = State r v
+    succs = successors c g
+    s'' = visit c succs s'
+
+-- | find tx params between given models: [A, B, C] => params (A, B), params (B, C).
+findParams :: [ModelId] -> TxGraph a -> [a]
+findParams ms (TxGraph _ es)
+    | length ps == length r = r
+    | otherwise = []
+  where
+    ps = zip ms (tail ms)
+    r = mapMaybe (`findParam` es) ps
+
+-- | find tx params between (A, B).
+findParam :: (ModelId, ModelId) -> [Edge a] -> Maybe a
+findParam p es = fmap (\(Edge _ pa _) -> pa) (find (edgeEq p) es)
+
+-- | edge eq given pair?
+edgeEq :: (ModelId, ModelId) -> Edge a -> Bool
+edgeEq (m1, m2) (Edge m1' _ m2') = m1 == m1' && m2 == m2'
+
+-- | @transformGeoc gc tx7@ returns the geocentric coordinates resulting from applying the 7-parameter
+-- transformation @tx7@ to the geocentric coordinates represented by vector @gc@.
+transformGeoc :: Vector3d -> TxParams7 -> Vector3d
+transformGeoc gc (TxParams7 c s r) = vadd c (vscale (vmultm gc (rotation r)) (1.0 + s))
+
+rotation :: Vector3d -> [Vector3d]
+rotation (Vector3d x y z) = [Vector3d 1.0 (-z) y, Vector3d z 1.0 (-x), Vector3d (-y) x 1.0]
+ src/Data/Geo/Jord/Txs.hs view
@@ -0,0 +1,173 @@+-- | +-- Module:      Data.Geo.Jord.Txs +-- Copyright:   (c) 2020 Cedric Liegeois +-- License:     BSD3 +-- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr> +-- Stability:   experimental +-- Portability: portable +--+-- Coordinates transformation parameters between various models.+--+--    * params: tx ty tz s rx ry rz+--+--    * rates:  tx ty tz s rx ry rz+--+--    * translations in millimetres, rates in millimetres per year+--+--    * scale factors in parts per billion, rates in parts per billion per year+--+--    * rotations in milliarcseconds, rates in milliarcseconds per year+--+-- This module has been generated.+--+module Data.Geo.Jord.Txs where++import Data.Geo.Jord.Model+import Data.Geo.Jord.Tx++-- | WGS84 to NAD83 transformation parameters.+from_WGS84_to_NAD83 :: Tx TxParams7+from_WGS84_to_NAD83 =+    Tx (ModelId "WGS84")+        (ModelId "NAD83")+        (txParams7 (995.6, -1910.3, -521.5) (-0.62) (25.915, 9.426, 11.599))++-- | WGS84 to ED50 transformation parameters.+from_WGS84_to_ED50 :: Tx TxParams7+from_WGS84_to_ED50 =+    Tx (ModelId "WGS84")+        (ModelId "ED50")+        (txParams7 (89500.0, 93800.0, 123100.0) (-1200.0) (0.0, 0.0, 156.0))++-- | WGS84 to ETRS89 transformation parameters.+from_WGS84_to_ETRS89 :: Tx TxParams7+from_WGS84_to_ETRS89 =+    Tx (ModelId "WGS84")+        (ModelId "ETRS89")+        (txParams7 (0.0, 0.0, 0.0) 0.0 (0.0, 0.0, 0.0))++-- | WGS84 to Irl1975 transformation parameters.+from_WGS84_to_Irl1975 :: Tx TxParams7+from_WGS84_to_Irl1975 =+    Tx (ModelId "WGS84")+        (ModelId "Irl1975")+        (txParams7 (-48253.0, 13059.6, -56455.7) (-815.0) (104.2, 214.0, 631.0))++-- |WGS84 to NAD27 transformation parameters.+from_WGS84_to_NAD27 :: Tx TxParams7+from_WGS84_to_NAD27 =+    Tx (ModelId "WGS84")+        (ModelId "NAD27")+        (txParams7 (8000.0, -160000.0, -176000.0) 0.0 (0.0, 0.0, 0.0))++-- |WGS84 to NTF transformation parameters.+from_WGS84_to_NTF :: Tx TxParams7+from_WGS84_to_NTF =+    Tx (ModelId "WGS84")+        (ModelId "NTF")+        (txParams7 (168000.0, 60000.0, -320000.0) 0.0 (0.0, 0.0, 0.0))++-- |WGS84 to OSGB36 transformation parameters.+from_WGS84_to_OSGB36 :: Tx TxParams7+from_WGS84_to_OSGB36 =+    Tx (ModelId "WGS84")+        (ModelId "OSGB36")+        (txParams7 (-44644.8, 12515.7, -54206.0) 20489.4 (-150.2, -247.0, -842.1))++-- |WGS84 to Potsdam transformation parameters.+from_WGS84_to_Potsdam :: Tx TxParams7+from_WGS84_to_Potsdam =+    Tx (ModelId "WGS84")+        (ModelId "Potsdam")+        (txParams7 (-582000.0, -105000.0, -414000.0) (-8300.0) (1040.0, 350.0, -3080.0))++-- |WGS84 to TokyoJapan transformation parameters.+from_WGS84_to_TokyoJapan :: Tx TxParams7+from_WGS84_to_TokyoJapan =+    Tx (ModelId "WGS84")+        (ModelId "TokyoJapan")+        (txParams7 (148000.0, -507000.0, -685000.0) 0.0 (0.0, 0.0, 0.0))++-- |WGS84 to WGS72 transformation parameters.+from_WGS84_to_WGS72 :: Tx TxParams7+from_WGS84_to_WGS72 =+    Tx (ModelId "WGS84")+        (ModelId "WGS72")+        (txParams7 (0.0, 0.0, -4500.0) (-220.0) (0.0, 0.0, 554.0))++-- | ITRF2014 to ITRF2008 transformation parameters.+from_ITRF2014_to_ITRF2008 :: Tx TxParams15+from_ITRF2014_to_ITRF2008 =+    Tx (ModelId "ITRF2014")+        (ModelId "ITRF2008")+        (TxParams15+             (Epoch 2010.0)+             (txParams7 (1.6, 1.9, 2.4) (-2.0e-2) (0.0, 0.0, 0.0))+             (txRates (0.0, 0.0, -0.1) 3.0e-2 (0.0, 0.0, 0.0)))++-- | ITRF2014 to ITRF2005 transformation parameters.+from_ITRF2014_to_ITRF2005 :: Tx TxParams15+from_ITRF2014_to_ITRF2005 =+    Tx (ModelId "ITRF2014")+        (ModelId "ITRF2005")+        (TxParams15+             (Epoch 2010.0)+             (txParams7 (2.6, 1.0, -2.3) 0.92 (0.0, 0.0, 0.0))+             (txRates (0.3, 0.0, -0.1) 3.0e-2 (0.0, 0.0, 0.0)))++-- | ITRF2014 to ITRF2000 transformation parameters.+from_ITRF2014_to_ITRF2000 :: Tx TxParams15+from_ITRF2014_to_ITRF2000 =+    Tx (ModelId "ITRF2014")+        (ModelId "ITRF2000")+        (TxParams15+             (Epoch 2010.0)+             (txParams7 (0.7, 1.2, -26.1) 2.12 (0.0, 0.0, 0.0))+             (txRates (0.1, 0.1, -1.9) 0.11 (0.0, 0.0, 0.0)))++-- | ITRF2014 to ETRF2000 transformation parameters.+from_ITRF2014_to_ETRF2000 :: Tx TxParams15+from_ITRF2014_to_ETRF2000 =+    Tx (ModelId "ITRF2014")+        (ModelId "ETRF2000")+        (TxParams15+             (Epoch 2000.0)+             (txParams7 (53.7, 51.2, -55.1) 1.02 (0.891, 5.39, -8.712))+             (txRates (0.1, 0.1, -1.9) 0.11 (8.1e-2, 0.49, -0.792)))++-- | ITRF2000 to NAD83 (CORS96) transformation parameters.+from_ITRF2000_to_NAD83_CORS96 :: Tx TxParams15+from_ITRF2000_to_NAD83_CORS96 =+    Tx (ModelId "ITRF2000")+        (ModelId "NAD83_CORS96")+        (TxParams15+             (Epoch 1997.0)+             (txParams7 (995.6, -1901.3, -521.5) 0.62 (25.915, 9.426, 11.599))+             (txRates (0.7, -0.7, 0.5) (-0.18) (6.7e-2, -0.757, -5.1e-2)))++-- | Graph of all static transformations.+staticTxs :: TxGraph TxParams7+staticTxs =+    txGraph+        [ from_WGS84_to_NAD83+        , from_WGS84_to_ED50+        , from_WGS84_to_ETRS89+        , from_WGS84_to_Irl1975+        , from_WGS84_to_NAD27+        , from_WGS84_to_NTF+        , from_WGS84_to_OSGB36+        , from_WGS84_to_Potsdam+        , from_WGS84_to_TokyoJapan+        , from_WGS84_to_WGS72+        ]++-- | Graph of all dynamic transformations.+dynamicTxs :: TxGraph TxParams15+dynamicTxs =+    txGraph+        [ from_ITRF2014_to_ITRF2008+        , from_ITRF2014_to_ITRF2005+        , from_ITRF2014_to_ITRF2000+        , from_ITRF2014_to_ETRF2000+        , from_ITRF2000_to_NAD83_CORS96+        ]
src/Data/Geo/Jord/Vector3d.hs view
@@ -1,22 +1,21 @@ -- |
 -- Module:      Data.Geo.Jord.Vector3d
--- Copyright:   (c) 2018 Cedric Liegeois
+-- Copyright:   (c) 2020 Cedric Liegeois
 -- License:     BSD3
 -- Maintainer:  Cedric Liegeois <ofmooseandmen@yahoo.fr>
 -- Stability:   experimental
 -- Portability: portable
 --
--- 3-element vectors.
+-- 3-element vector.
 --
 module Data.Geo.Jord.Vector3d
     ( Vector3d(..)
-    , IsVector3d(..)
     , vadd
     , vsub
     , vdot
     , vnorm
     , vcross
-    , vrotate
+    , vmultm
     , vscale
     , vunit
     , vzero
@@ -25,15 +24,13 @@     ) where
 
 -- | 3-element vector.
-data Vector3d = Vector3d
-    { vx :: Double
-    , vy :: Double
-    , vz :: Double
-    } deriving (Eq, Show)
-
--- | class for data types assimilated to 'Vector3d'.
-class IsVector3d a where
-    vec :: a -> Vector3d
+data Vector3d =
+    Vector3d
+        { vx :: Double
+        , vy :: Double
+        , vz :: Double
+        }
+    deriving (Eq, Show)
 
 -- | Adds 2 vectors.
 vadd :: Vector3d -> Vector3d -> Vector3d
@@ -71,10 +68,10 @@     y = vy v
     z = vz v
 
--- | @vrotate v rm@ applies rotation matrix @rm@ to @v@.
-vrotate :: Vector3d -> [Vector3d] -> Vector3d
-vrotate v rm
-    | length rm /= 3 = error ("Invalid rotation matrix" ++ show rm)
+-- | @vmultm v rm@ multiplies vector @v@ by __3x3__ matrix @m@ (rows).
+vmultm :: Vector3d -> [Vector3d] -> Vector3d
+vmultm v rm
+    | length rm /= 3 = error ("Invalid matrix" ++ show rm)
     | otherwise = Vector3d x y z
   where
     [x, y, z] = map (vdot v) rm
@@ -110,7 +107,7 @@ transpose' ([]:_) = []
 transpose' x = map head x : transpose' (map tail x)
 
--- | multiplies 2 __square (3x3)__ matrices of 'Vector3d'.
+-- | multiplies 2 __3x3__ matrices.
 mdot :: [Vector3d] -> [Vector3d] -> [Vector3d]
 mdot a b = fmap ds2v [[vdot ar bc | bc <- transpose b] | ar <- a]
 
@@ -121,4 +118,4 @@ -- | list of doubles to 'Vector3d'.
 ds2v :: [Double] -> Vector3d
 ds2v [x', y', z'] = Vector3d x' y' z'
-ds2v xs = error ("Invalid list: " ++ show xs)
+ds2v xs = error ("Invalid list: " ++ show xs)
test/Data/Geo/Jord/AngleSpec.hs view
@@ -2,23 +2,29 @@     ( spec
     ) where
 
-import Data.Geo.Jord
-import System.IO
+import System.IO (hSetEncoding, stderr, stdin, stdout, utf8)
+
 import Test.Hspec
 
+import Data.Geo.Jord.Angle
+import Data.Geo.Jord.Length
+import Data.Geo.Jord.Quantity
+
 spec :: Spec
 spec = do
     describe "Reading valid angles" $ do
-        it "reads 55°36'21\"" $ readAngle "55°36'21\"" `shouldBe` decimalDegrees 55.6058333
-        it "reads 55°36'21''" $ readAngle "55°36'21''" `shouldBe` decimalDegrees 55.6058333
-        it "reads 55d36m21.0s" $ readAngle "55d36m21.0s" `shouldBe` decimalDegrees 55.6058333
-        it "reads 55.6058333°" $ readAngle "55.6058333°" `shouldBe` decimalDegrees 55.6058333
-        it "reads -55.6058333°" $ readAngle "-55.6058333°" `shouldBe` decimalDegrees (-55.6058333)
+        it "reads 55°36'21\"" $ readAngle "55°36'21\"" `shouldBe` Just (decimalDegrees 55.6058333333)
+        it "reads 55°36'21''" $ readAngle "55°36'21''" `shouldBe` Just (decimalDegrees 55.6058333333)
+        it "reads 55d36m21.0s" $ readAngle "55d36m21.0s" `shouldBe` Just (decimalDegrees 55.6058333333)
+        it "reads 55.6058333°" $ readAngle "55.6058333°" `shouldBe` Just (decimalDegrees 55.6058333)
+        it "reads 55.6058333333°" $ readAngle "55.6058333333°" `shouldBe` Just (decimalDegrees 55.6058333333)
+        it "reads -55.6058333333°" $
+            readAngle "-55.6058333333°" `shouldBe` Just (decimalDegrees (-55.6058333333))
         it "reads 96°01′18″" $ do
             hSetEncoding stdin utf8
             hSetEncoding stdout utf8
             hSetEncoding stderr utf8
-            readAngle "96°01′18″" `shouldBe` decimalDegrees 96.02166666
+            readAngle "96°01′18″" `shouldBe` Just (decimalDegrees 96.02166666666)
     describe "Adding/Subtracting angles" $ do
         it "adds angles" $
             add (decimalDegrees 55.6058333) (decimalDegrees 5.0) `shouldBe`
@@ -32,9 +38,9 @@         it "350 degrees normalised to [0..360] = 350" $
             normalise (decimalDegrees 350) (decimalDegrees 360) `shouldBe` decimalDegrees 350
     describe "Angle equality" $ do
-        it "considers 59.9999999° == 60.0°" $ decimalDegrees 59.9999999 `shouldBe` decimalDegrees 60
-        it "considers 59.9999998° /= 60.0°" $
-            decimalDegrees 59.9999998 `shouldNotBe` decimalDegrees 60
+        it "considers 59.9999999999° == 60.0°" $ decimalDegrees 59.9999999999 `shouldBe` decimalDegrees 60
+        it "considers 59.999999998° /= 60.0°" $
+            decimalDegrees 59.999999998 `shouldNotBe` decimalDegrees 60
     describe "Showing angles" $ do
         it "shows 59.99999999999999 as 60°0'0.000\"" $
             show (decimalDegrees 59.99999999999999) `shouldBe` "60°0'0.000\""
@@ -46,47 +52,47 @@         it "show -0.5245 as -0°31'28.800\"" $
             show (decimalDegrees (-0.5245)) `shouldBe` "-0°31'28.200\""
     describe "Angle from decimal degrees" $ do
-        it "returns 1 millisecond when called with 1 / 3600000" $ do
+        it "returns 1 arcmillisecond when called with 1 / 3600000" $ do
             let actual = decimalDegrees (1 / 3600000)
             getDegrees actual `shouldBe` 0
-            getMinutes actual `shouldBe` 0
-            getSeconds actual `shouldBe` 0
-            getMilliseconds actual `shouldBe` 1
-        it "returns 1 second when called with 1000 / 3600000" $ do
+            getArcminutes actual `shouldBe` 0
+            getArcseconds actual `shouldBe` 0
+            getArcmilliseconds actual `shouldBe` 1
+        it "returns 1 arcsecond when called with 1000 / 3600000" $ do
             let actual = decimalDegrees (1000 / 3600000)
             getDegrees actual `shouldBe` 0
-            getMinutes actual `shouldBe` 0
-            getSeconds actual `shouldBe` 1
-            getMilliseconds actual `shouldBe` 0
-        it "returns 1 minute when called with 60000 / 3600000" $ do
+            getArcminutes actual `shouldBe` 0
+            getArcseconds actual `shouldBe` 1
+            getArcmilliseconds actual `shouldBe` 0
+        it "returns 1 arcminute when called with 60000 / 3600000" $ do
             let actual = decimalDegrees (60000 / 3600000)
             getDegrees actual `shouldBe` 0
-            getMinutes actual `shouldBe` 1
-            getSeconds actual `shouldBe` 0
-            getMilliseconds actual `shouldBe` 0
+            getArcminutes actual `shouldBe` 1
+            getArcseconds actual `shouldBe` 0
+            getArcmilliseconds actual `shouldBe` 0
         it "returns 1 degree when called with 1" $ do
             let actual = decimalDegrees 1
             getDegrees actual `shouldBe` 1
-            getMinutes actual `shouldBe` 0
-            getSeconds actual `shouldBe` 0
-            getMilliseconds actual `shouldBe` 0
+            getArcminutes actual `shouldBe` 0
+            getArcseconds actual `shouldBe` 0
+            getArcmilliseconds actual `shouldBe` 0
         it "accepts positve values" $ do
             let actual = decimalDegrees 154.9150300
             getDegrees actual `shouldBe` 154
-            getMinutes actual `shouldBe` 54
-            getSeconds actual `shouldBe` 54
-            getMilliseconds actual `shouldBe` 108
+            getArcminutes actual `shouldBe` 54
+            getArcseconds actual `shouldBe` 54
+            getArcmilliseconds actual `shouldBe` 108
         it "accepts negative values" $ do
             let actual = decimalDegrees (-154.915)
             getDegrees actual `shouldBe` (-154)
-            getMinutes actual `shouldBe` 54
-            getSeconds actual `shouldBe` 54
-            getMilliseconds actual `shouldBe` 0
+            getArcminutes actual `shouldBe` 54
+            getArcseconds actual `shouldBe` 54
+            getArcmilliseconds actual `shouldBe` 0
     describe "Arc length" $ do
-        it "computes the length of an arc with a central angle of 1 milliseconds" $
-            arcLength (decimalDegrees (1.0 / 3600000.0)) (meanRadius wgs84) `shouldBe` metres 0.0309
+        it "computes the length of an arc with a central angle of 1 microarcsecond" $
+            arcLength (decimalDegrees (1.0 / 3600000000.0)) (kilometres 10000) `shouldBe` metres 4.8e-5
         it
-            "arc length with central angle of 0.6 milliseconds == arc length with central angle of 1 milliseconds" $
-            arcLength (decimalDegrees (0.6 / 3600000.0)) (meanRadius wgs84) `shouldBe` metres 0.0309
-        it "arc length with central angle of 0.5 milliseconds == 0" $
-            arcLength (decimalDegrees (0.4 / 3600000.0)) (meanRadius wgs84) `shouldBe` metres 0
+            "computes arc length with central angle of 0.6 microarcsecond" $
+            arcLength (decimalDegrees (0.6 / 3600000000.0)) (kilometres 10000) `shouldBe` metres 4.8e-5
+        it "computes arc length with central angle of 0.4 microarcsecond as 0" $
+            arcLength (decimalDegrees (0.4 / 3600000000.0)) (kilometres 1) `shouldBe` metres 0
test/Data/Geo/Jord/DurationSpec.hs view
@@ -1,26 +1,28 @@-module Data.Geo.Jord.DurationSpec-    ( spec-    ) where--import Data.Geo.Jord-import Test.Hspec--spec :: Spec-spec = do-    describe "Reading valid durations" $ do-        it "reads 1H45M36.5S" $ readDuration "1H45M36.5S" `shouldBe` hms 1 45 36.5-        it "reads 45M" $ readDuration "45M" `shouldBe` minutes 45-        it "reads 36S" $ readDuration "36S" `shouldBe` seconds 36-        it "reads 36.6S" $ readDuration "36.6S" `shouldBe` milliseconds 36600-        it "read 1H-30M" $ readDuration "1H-30M" `shouldBe` hours 0.5-    describe "Reading invalid duration" $-        it "fails to read 5" $ readDurationE "5" `shouldBe` Left "couldn't read duration 5"-    describe "Showing duration" $-        it "shows duration" $ show (hms 1 45 36.5) `shouldBe` "1H45M36.500S"-    describe "Converting duration" $ do-        it "converts hours to seconds" $ toSeconds (hours 1) `shouldBe` 3600.0-        it "converts minutes to hours" $ toHours (minutes 30) `shouldBe` 0.5-        it "converts duration to milliseconds" $ toMilliseconds (hms 1 54 3.154) `shouldBe` 6843154-    describe "Adding/Subtracting duration" $ do-        it "adds duration" $ add (minutes 45) (seconds 36) `shouldBe` hms 0 45 36-        it "subtracts duration" $ sub (hours 1) (minutes 60) `shouldBe` zero+module Data.Geo.Jord.DurationSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.Duration
+import Data.Geo.Jord.Quantity
+
+spec :: Spec
+spec = do
+    describe "Reading valid durations" $ do
+        it "reads 1H45M36.5S" $ readDuration "1H45M36.5S" `shouldBe` Just (hms 1 45 36.5)
+        it "reads 45M" $ readDuration "45M" `shouldBe` Just (minutes 45)
+        it "reads 36S" $ readDuration "36S" `shouldBe` Just (seconds 36)
+        it "reads 36.6S" $ readDuration "36.6S" `shouldBe` Just (milliseconds 36600)
+        it "reads 1H-30M" $ readDuration "1H-30M" `shouldBe` Just (hours 0.5)
+        it "reads 0H8M5.953S" $ readDuration "0H8M5.953S" `shouldBe` Just (seconds 485.953)
+    describe "Reading invalid duration" $ it "fails to read 5" $ readDuration "5" `shouldBe` Nothing
+    describe "Showing duration" $
+        it "shows duration" $ show (hms 1 45 36.5) `shouldBe` "1H45M36.500S"
+    describe "Converting duration" $ do
+        it "converts hours to seconds" $ toSeconds (hours 1) `shouldBe` 3600.0
+        it "converts minutes to hours" $ toHours (minutes 30) `shouldBe` 0.5
+        it "converts duration to milliseconds" $ toMilliseconds (hms 1 54 3.154) `shouldBe` 6843154
+    describe "Adding/Subtracting duration" $ do
+        it "adds duration" $ add (minutes 45) (seconds 36) `shouldBe` hms 0 45 36
+        it "subtracts duration" $ sub (hours 1) (minutes 60) `shouldBe` zero
− test/Data/Geo/Jord/EarthSpec.hs 
@@ -1,27 +0,0 @@-module Data.Geo.Jord.EarthSpec
-    ( spec
-    ) where
-
-import Data.Geo.Jord
-import Test.Hspec
-
-spec :: Spec
-spec = do
-    describe "Eccentricity" $ do
-        it "returns 0.08181919084262157 for the WGS84 ellipsoid" $
-            eccentricity wgs84 `shouldBe` 0.08181919084262157
-        it "returns 0.08181919104281514 for the GRS80 ellipsoid" $
-            eccentricity grs80 `shouldBe` 0.08181919104281514
-        it "returns 0.08181881066274845 for the WG72 ellipsoid" $
-            eccentricity wgs72 `shouldBe` 0.08181881066274845
-    describe "Polar radius" $ do
-        it "returns 6356752.3142 m for the WGS84 ellipsoid" $
-            polarRadius wgs84 `shouldBe` metres 6356752.3142
-        it "returns 6356752.3141 m for the GRS80 ellipsoid" $
-            polarRadius grs80 `shouldBe` metres 6356752.3141
-        it "returns 6356750.52 m for the WG72 ellipsoid" $
-            polarRadius wgs72 `shouldBe` metres 6356750.52
-    describe "Mean radius" $ do
-        it "returns 6371008.7714 m for the WGS84 ellipsoid" $ r84 `shouldBe` metres 6371008.7714
-        it "returns 6371008.7714 m for the GRS80 ellipsoid" $ r80 `shouldBe` metres 6371008.7714
-        it "returns 6371006.84 m for the WG72 ellipsoid" $ r72 `shouldBe` metres 6371006.84
+ test/Data/Geo/Jord/EllipsoidSpec.hs view
@@ -0,0 +1,37 @@+module Data.Geo.Jord.EllipsoidSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.Ellipsoid
+import Data.Geo.Jord.Ellipsoids
+import Data.Geo.Jord.Length
+
+spec :: Spec
+spec = do
+    describe "Eccentricity" $ do
+        it "returns 0.08181919084262157 for the WGS84 ellipsoid" $
+            eccentricity eWGS84 `shouldBe` 0.08181919084262157
+        it "returns 0.08181919104281514 for the GRS80 ellipsoid" $
+            eccentricity eGRS80 `shouldBe` 0.08181919104281514
+        it "returns 0.08181881066274845 for the WG72 ellipsoid" $
+            eccentricity eWGS72 `shouldBe` 0.08181881066274845
+        it "returns 0 for the spherical models" $ do
+            eccentricity (toSphere eWGS84) `shouldBe` 0
+            eccentricity (toSphere eGRS80) `shouldBe` 0
+            eccentricity (toSphere eWGS72) `shouldBe` 0
+    describe "Polar radius" $ do
+        it "returns 6356752.314245 m for the WGS84 ellipsoid" $
+            polarRadius eWGS84 `shouldBe` metres 6356752.314245
+        it "returns 6356752.31414 m for the GRS80 ellipsoid" $
+            polarRadius eGRS80 `shouldBe` metres 6356752.31414
+        it "returns 6356750.520016 m for the WG72 ellipsoid" $
+            polarRadius eWGS72 `shouldBe` metres 6356750.520016
+    describe "Mean radius" $ do
+        it "returns 6371008.771415 m for the WGS84 ellipsoid" $
+            meanRadius eWGS84 `shouldBe` metres 6371008.771415
+        it "returns 6371008.77138 m for the GRS80 ellipsoid" $
+            meanRadius eGRS80 `shouldBe` metres 6371008.77138
+        it "returns 6371006.840005 m for the WG72 ellipsoid" $
+            meanRadius eWGS72 `shouldBe` metres 6371006.840005
− test/Data/Geo/Jord/FramesSpec.hs 
@@ -1,77 +0,0 @@-module Data.Geo.Jord.FramesSpec
-    ( spec
-    ) where
-
-import Data.Geo.Jord
-import Test.Hspec
-
-spec :: Spec
-spec = do
-    describe "Ellipsoidal earth model" $ do
-        describe "target" $ do
-            it "return the given point if NED norm = 0" $ do
-                let p0 = readLatLong "531914N0014347W"
-                let d = ned zero zero zero
-                targetN p0 d wgs84 `shouldBe` p0
-            it "computes the target point from p0 and NED" $ do
-                let p0 = decimalLatLong 49.66618 3.45063
-                let d = nedMetres (-86126) (-78900) 1069
-                targetN p0 d wgs84 `shouldBe` decimalLatLong 48.8866688 2.374721388
-            it "computes the target point from p0 and vector in Frame B" $ do
-                let p0 = decimalLatLongHeight 49.66618 3.45063 zero
-                let y = decimalDegrees 10 -- yaw
-                let r = decimalDegrees 20 -- roll
-                let p = decimalDegrees 30 -- pitch
-                let d = deltaMetres 3000 2000 100
-                target p0 (frameB y r p) d wgs84 `shouldBe`
-                    decimalLatLongHeight 49.6918016 3.4812669 (metres 6.0077)
-        describe "nedBetween" $ do
-            it "computes NED between LatLong positions" $ do
-                let p1 = decimalLatLong 49.66618 3.45063
-                let p2 = decimalLatLong 48.88667 2.37472
-                let d = nedBetween p1 p2 wgs84
-                d `shouldBe` nedMetres (-86125.8805) (-78900.0878) 1069.1984
-            it "computes NED between angular positions" $ do
-                let p1 = decimalLatLongHeight 49.66618 3.45063 zero
-                let p2 = decimalLatLongHeight 48.88667 2.37472 zero
-                let d = nedBetween p1 p2 wgs84
-                d `shouldBe` nedMetres (-86125.8805) (-78900.0878) 1069.1984
-        describe "deltaBetween" $
-            it "computes delta between angular positions in frame L" $ do
-                let p1 = decimalLatLongHeight 1 2 (metres (-3))
-                let p2 = decimalLatLongHeight 4 5 (metres (-6))
-                let w = decimalDegrees 5 -- wander azimuth
-                let d = deltaBetween p1 p2 (frameL w) wgs84
-                d `shouldBe` deltaMetres 359490.5782 302818.5226 17404.2713
-        describe "deltaBetween and target consistency" $
-            it "computes targetN p1 (nedBetween p1 p2) = p2" $ do
-                let p1 = decimalLatLongHeight 49.66618 3.45063 zero
-                let p2 = decimalLatLongHeight 48.88667 2.37472 zero
-                targetN p1 (nedBetween p1 p2 wgs84) wgs84 `shouldBe` p2
-        describe "rotation matrix to go from/to earth-fixed frame to/from frame" $ do
-            it "computes the rotation matrix to go from Frame N to earth-fixed frame" $ do
-                let p = decimalLatLong 49.66618 3.45063
-                let f = frameN p wgs84
-                rEF f `shouldBe`
-                    [ Vector3d (-0.7609044147650337) (-6.0188455103478165e-2) (-0.6460664218664659)
-                    , Vector3d (-4.588084172652564e-2) 0.9981870315087531 (-3.8956366491356864e-2)
-                    , Vector3d 0.6472398473159291 0.0 (-0.7622864160185809)
-                    ]
-            it "computes the rotation matrix to go from Frame B to earth-fixed frame" $ do
-                let p = decimalLatLong 49.66618 3.45063
-                let f = frameB (decimalDegrees 10) (decimalDegrees 20) (decimalDegrees 30) p wgs84
-                rEF f `shouldBe`
-                    [ Vector3d (-0.4930071357985816) (-0.3703899170611777) (-0.787245370511058)
-                    , Vector3d 0.13374504886728417 0.8618333991629544 (-0.4892396692733688)
-                    , Vector3d 0.8596837941680457 (-0.3464888186170537) (-0.37535219809958753)
-                    ]
-    describe "North, East, Down delta" $ do
-        describe "slantRange" $
-            it "computes the slant range of a NED vector" $
-            slantRange (nedMetres (-86126) (-78900) 1069) `shouldBe` metres 116807.708
-        describe "bearing" $
-            it "computes the bearing of a NED vector" $
-            bearing (nedMetres (-86126) (-78900) 1069) `shouldBe` decimalDegrees 222.4927888
-        describe "elevation" $
-            it "computes the elevation of a NED vector from horizontal" $
-            elevation (nedMetres (-86126) (-78900) 1069) `shouldBe` decimalDegrees (-0.5243663)
+ test/Data/Geo/Jord/GeodesicSpec.hs view
@@ -0,0 +1,101 @@+module Data.Geo.Jord.GeodesicSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.Geodesic
+import Data.Geo.Jord.Position
+
+-- | See Geodesy Test Harness - latlon-ellipsoidal-vincenty  by Chris Veness - TODO link
+spec :: Spec
+spec = do
+    describe "Geodesic for (near) antipodal positions" $ do
+        it "handles near-antipodal positions" $
+            surfaceDistance (latLongPos 0 0 WGS84) (latLongPos 0.5 179.5 WGS84) `shouldBe`
+            Just (kilometres 19936.288578981)
+        it "returns Nothing if vincenty fails to converge - inverseGeodesic" $
+            inverseGeodesic (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84) `shouldBe` Nothing
+        it "returns Nothing if vincenty fails to converge - surfaceDistance" $
+            surfaceDistance (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84) `shouldBe` Nothing
+        it "returns Nothing if vincenty fails to converge - initialBearing" $
+            initialBearing (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84) `shouldBe` Nothing
+        it "returns Nothing if vincenty fails to converge - finalBearing" $
+            finalBearing (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84) `shouldBe` Nothing
+        it "handle antipodal positions - surfaceDistance at equator" $
+            surfaceDistance (latLongPos 0 0 WGS84) (latLongPos 0 180 WGS84) `shouldBe` Just (kilometres 20003.931458623)
+        it "handle antipodal positions - initialBearing at equator" $
+            initialBearing (latLongPos 0 0 WGS84) (latLongPos 0 180 WGS84) `shouldBe` Just zero
+        it "handle antipodal positions - surfaceDistance between poles" $
+            surfaceDistance (northPole WGS84) (southPole WGS84) `shouldBe` Just (kilometres 20003.931458623)
+        it "handle antipodal positions - initialBearing between poles" $
+            initialBearing (northPole WGS84) (southPole WGS84) `shouldBe` Just zero
+    describe "Geodesic for coincident positions" $ do
+        let p = wgs84Pos 48 6 zero
+        it "returns a distance of 0 and no bearing" $ do
+            let i = inverseGeodesic p p
+            let ib = i >>= geodesicBearing1
+            let fb = i >>= geodesicBearing2
+            fmap geodesicLength i `shouldBe` Just zero
+            ib `shouldBe` Nothing
+            fb `shouldBe` Nothing
+            surfaceDistance p p `shouldBe` Just zero
+            initialBearing p p `shouldBe` Nothing
+            finalBearing p p `shouldBe` Nothing
+        it "returns the given position when distance is 0" $ destination p (decimalDegrees 54) zero `shouldBe` Just p
+    describe "Geodesic for selected positions" $ do
+        let flindersPeak = latLongPos (-37.95103341666667) 144.42486788888888 WGS84
+        let buninyong = latLongPos (-37.65282113888889) 143.92649552777777 WGS84
+        let le = latLongPos 50.06632 (-5.71475) WGS84
+        let jog = latLongPos 58.64402 (-3.07009) WGS84
+        it "computes the surface distance - inverse" $ do
+            surfaceDistance flindersPeak buninyong `shouldBe` Just (metres 54972.271139)
+            surfaceDistance le jog `shouldBe` Just (kilometres 969.954166314)
+        it "computes the initial bearing - inverse" $ do
+            initialBearing flindersPeak buninyong `shouldBe` Just (decimalDegrees 306.86815920333333)
+            initialBearing le jog `shouldBe` Just (decimalDegrees 9.14187748888889)
+        it "computes the final bearing - inverse" $ do
+            finalBearing flindersPeak buninyong `shouldBe` Just (decimalDegrees 307.17363062944446)
+            finalBearing le jog `shouldBe` Just (decimalDegrees 11.297220414166667)
+        it "compute the destination - direct" $ do
+            destination flindersPeak (decimalDegrees 306.86815920333333) (metres 54972.271139) `shouldBe` Just buninyong
+            destination le (decimalDegrees 9.14187748888889) (kilometres 969.954166314) `shouldBe` Just jog
+        it "computes the final bearing - direct" $ do
+            let fb1 =
+                    directGeodesic flindersPeak (decimalDegrees 306.86815920333333) (metres 54972.271139) >>=
+                    geodesicBearing2
+            fb1 `shouldBe` Just (decimalDegrees 307.17363062944446)
+            let fb2 =
+                    directGeodesic le (decimalDegrees 9.14187748888889) (kilometres 969.954166314) >>= geodesicBearing2
+            fb2 `shouldBe` Just (decimalDegrees 11.297220414166667)
+    describe "Surface distance for anti-meridian positions" $
+        it "handles positions crossing antimeridian" $
+        surfaceDistance (latLongPos 30 120 WGS84) (latLongPos 30 (-120) WGS84) `shouldBe`
+        Just (kilometres 10825.924088908)
+    describe "Geodesic for quadrants" $
+        it "returns the same surface distance in all quadrants" $ do
+            let actuals =
+                    [ surfaceDistance (latLongPos 30 30 WGS84) (latLongPos 60 60 WGS84)
+                    , surfaceDistance (latLongPos 60 60 WGS84) (latLongPos 30 30 WGS84)
+                    , surfaceDistance (latLongPos 30 60 WGS84) (latLongPos 60 30 WGS84)
+                    , surfaceDistance (latLongPos 60 30 WGS84) (latLongPos 30 60 WGS84)
+                    , surfaceDistance (latLongPos 30 (-30) WGS84) (latLongPos 60 (-60) WGS84)
+                    , surfaceDistance (latLongPos 60 (-60) WGS84) (latLongPos 30 (-30) WGS84)
+                    , surfaceDistance (latLongPos 30 (-60) WGS84) (latLongPos 60 (-30) WGS84)
+                    , surfaceDistance (latLongPos 60 (-30) WGS84) (latLongPos 30 (-60) WGS84)
+                    , surfaceDistance (latLongPos (-30) (-30) WGS84) (latLongPos (-60) (-60) WGS84)
+                    , surfaceDistance (latLongPos (-60) (-60) WGS84) (latLongPos (-30) (-30) WGS84)
+                    , surfaceDistance (latLongPos (-30) (-60) WGS84) (latLongPos (-60) (-30) WGS84)
+                    , surfaceDistance (latLongPos (-60) (-30) WGS84) (latLongPos (-30) (-60) WGS84)
+                    , surfaceDistance (latLongPos (-30) 30 WGS84) (latLongPos (-60) 60 WGS84)
+                    , surfaceDistance (latLongPos (-60) 60 WGS84) (latLongPos (-30) 30 WGS84)
+                    , surfaceDistance (latLongPos (-30) 60 WGS84) (latLongPos (-60) 30 WGS84)
+                    , surfaceDistance (latLongPos (-60) 30 WGS84) (latLongPos (-30) 60 WGS84)
+                    ]
+            let expecteds = replicate (length actuals) (Just (kilometres 4015.703020938))
+            actuals `shouldBe` expecteds
+    describe "Inverse geodesic non-convergence" $ do
+        it "returns Nothing for antipodal λ > π" $
+            surfaceDistance (latLongPos 0 0 WGS84) (latLongPos 0.5 179.7 WGS84) `shouldBe` Nothing
+        it "returns Nothing for antipodal convergence" $
+            surfaceDistance (latLongPos 5 0 WGS84) (latLongPos (-5.1) 179.4 WGS84) `shouldBe` Nothing
− test/Data/Geo/Jord/GeodeticsSpec.hs 
@@ -1,251 +0,0 @@-module Data.Geo.Jord.GeodeticsSpec-    ( spec-    ) where--import Control.Exception.Base-import Data.Geo.Jord-import Data.Maybe (fromJust)-import Test.Hspec--spec :: Spec-spec = do-    describe "alongTrackDistance" $ do-        it "returns a positive length when position is ahead start of great arc" $ do-            let p = decimalLatLong 53.2611 (-0.7972)-            let ga = greatArc (decimalLatLong 53.3206 (-1.7297), decimalLatLong 53.1887 0.1334)-            alongTrackDistance p ga r84 `shouldBe` kilometres 62.3315757-        it "returns a negative length when position is ahead start of great arc" $ do-            let p = decimalLatLong 53.3206 (-1.7297)-            let ga = greatArc (decimalLatLong 53.2611 (-0.7972), decimalLatLong 53.1887 0.1334)-            alongTrackDistance p ga r84 `shouldBe` kilometres (-62.3293209)-        it "returns a 0 when position is start of great arc" $ do-            let p = decimalLatLong 53.2611 (-0.7972)-            let ga = greatArc (p, decimalLatLong 53.1887 0.1334)-            alongTrackDistance p ga r84 `shouldBe` zero-    describe "antipode" $ do-        it "returns the antipodal point" $ do-            let p = latLongHeight (readLatLong "484137N0061105E") (metres 15000)-            let e = decimalLatLongHeight (-48.6936111) (-173.8152777) (metres 15000)-            antipode p `shouldBe` e-        it "returns the south pole when called with the north pole" $-            antipode northPole `shouldBe` southPole-        it "returns the north pole when called with the south pole" $-            antipode southPole `shouldBe` northPole-    describe "crossTrackDistance" $ do-        it "returns a negative length when position is left of great circle (bearing)" $ do-            let p = decimalLatLong 53.2611 (-0.7972)-            let gc = greatCircle (decimalLatLong 53.3206 (-1.7297), decimalDegrees 96.0)-            crossTrackDistance p gc r84 `shouldBe` metres (-305.6629)-        it "returns a negative length when position is left of great circle" $ do-            let p = decimalLatLong 53.2611 (-0.7972)-            let gc = greatCircle (decimalLatLong 53.3206 (-1.7297), decimalLatLong 53.1887 0.1334)-            crossTrackDistance p gc r84 `shouldBe` metres (-307.5471)-        it "returns a positve length when position is right of great circle (bearing)" $ do-            let p = readLatLong "531540N0014750W"-            let gc = greatCircle (readLatLong "531914N0014347W", readAngle "96d01m18s")-            crossTrackDistance p gc r84 `shouldBe` metres 7042.3242-        it "returns a positive length when position is left of great circle" $ do-            let p = antipode (decimalLatLong 53.2611 (-0.7972))-            let gc = greatCircle (decimalLatLong 53.3206 (-1.7297), decimalLatLong 53.1887 0.1334)-            crossTrackDistance p gc r84 `shouldBe` metres 307.5471-    describe "destination" $ do-        it "return the given point if distance is 0 meter" $ do-            let p0 = readLatLong "531914N0014347W"-            destination p0 (decimalDegrees 96.0217) zero r84 `shouldBe` p0-        it "return the angular position along great-circle at distance and bearing" $ do-            let p0 = latLongHeight (readLatLong "531914N0014347W") (metres 15000.0)-            let p1 = decimalLatLongHeight 53.1882691 0.1332744 (metres 15000.0)-            destination p0 (decimalDegrees 96.0217) (metres 124800) r84 `shouldBe` p1-        it "return the ECEF position along great-circle at distance and bearing" $ do-            let p0 = ecefToNVector (ecefMetres 3812864.094 (-115142.863) 5121515.161) s84-            let p1 = ecefMetres 3826406.471 8900.5364 5112694.2331-            let p = destination84 p0 (decimalDegrees 96.0217) (metres 124800)-            nvectorToEcef p s84 `shouldBe` p1-    describe "finalBearing" $ do-        it "returns the Nothing if both point are the same" $ do-            let p = readLatLong "500359N0054253W"-            finalBearing p p `shouldBe` Nothing-        it "returns 0° if both point have the same longitude (going north)" $ do-            let p1 = latLongHeight (readLatLong "500359N0054253W") (metres 12000)-            let p2 = latLongHeight (readLatLong "583838N0054253W") (metres 5000)-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 0)-        it "returns 180° if both point have the same longitude (going south)" $ do-            let p1 = latLongHeight (readLatLong "583838N0054253W") (metres 12000)-            let p2 = latLongHeight (readLatLong "500359N0054253W") (metres 5000)-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 180)-        it "returns 90° at the equator going east" $ do-            let p1 = latLongHeight (readLatLong "000000N0000000E") (metres 12000)-            let p2 = latLongHeight (readLatLong "000000N0010000E") (metres 5000)-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 90)-        it "returns 270° at the equator going west" $ do-            let p1 = latLongHeight (readLatLong "000000N0010000E") (metres 12000)-            let p2 = latLongHeight (readLatLong "000000N0000000E") (metres 5000)-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 270)-        it "returns the final bearing in compass angle" $ do-            let p1 = readLatLong "500359N0054253W"-            let p2 = readLatLong "583838N0030412W"-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 11.2752013)-        it "returns the final bearing in compass angle" $ do-            let p1 = readLatLong "583838N0030412W"-            let p2 = readLatLong "500359N0054253W"-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 189.1198181)-        it "returns the final bearing in compass angle" $ do-            let p1 = readLatLong "535941S0255915W"-            let p2 = readLatLong "54N154E"-            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 125.6839436)-    describe "greatCircle smart constructors" $ do-        it "fails if both positions are equal" $-            greatCircleE (decimalLatLong 3 154, decimalLatLong 3 154) `shouldBe`-            Left "Invalid Great Circle: positions are equal"-        it "fails if both positions are antipodal" $-            greatCircleE (decimalLatLong 3 154, antipode (decimalLatLong 3 154)) `shouldBe`-            Left "Invalid Great Circle: positions are antipodal"-    describe "initialBearing" $ do-        it "returns Nothing if both point are the same" $ do-            let p = readLatLong "500359N1795959W"-            initialBearing p p `shouldBe` Nothing-        it "returns 0° if both point have the same longitude (going north)" $ do-            let p1 = latLongHeight (readLatLong "500359N0054253W") (metres 12000)-            let p2 = latLongHeight (readLatLong "583838N0054253W") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)-        it "returns 180° if both point have the same longitude (going south)" $ do-            let p1 = latLongHeight (readLatLong "583838N0054253W") (metres 12000)-            let p2 = latLongHeight (readLatLong "500359N0054253W") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 180)-        it "returns 90° at the equator going east" $ do-            let p1 = latLongHeight (readLatLong "000000N0000000E") (metres 12000)-            let p2 = latLongHeight (readLatLong "000000N0010000E") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 90)-        it "returns 270° at the equator going west" $ do-            let p1 = latLongHeight (readLatLong "000000N0010000E") (metres 12000)-            let p2 = latLongHeight (readLatLong "000000N0000000E") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 270)-        it "returns the initial bearing in compass angle" $ do-            let p1 = latLongHeight (readLatLong "500359N0054253W") (metres 12000)-            let p2 = latLongHeight (readLatLong "583838N0030412W") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 9.1198181)-        it "returns the initial bearing in compass angle" $ do-            let p1 = latLongHeight (readLatLong "583838N0030412W") (metres 12000)-            let p2 = latLongHeight (readLatLong "500359N0054253W") (metres 5000)-            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 191.2752013)-    describe "interpolate" $ do-        let p1 = readLatLong "44N044E"-        let p2 = readLatLong "46N046E"-        it "fails if f < 0.0" $-            evaluate (interpolate p1 p2 (-0.5)) `shouldThrow`-            errorCall "fraction must be in range [0..1], was -0.5"-        it "fails if f > 1.0" $-            evaluate (interpolate p1 p2 1.1) `shouldThrow`-            errorCall "fraction must be in range [0..1], was 1.1"-        it "returns p0 if f == 0" $ interpolate p1 p2 0.0 `shouldBe` p1-        it "returns p1 if f == 1" $ interpolate p1 p2 1.0 `shouldBe` p2-        it "returns the interpolated position" $ do-            let p3 = latLongHeight (readLatLong "53°28'46''N 2°14'43''W") (metres 10000)-            let p4 = latLongHeight (readLatLong "55°36'21''N 13°02'09''E") (metres 20000)-            interpolate p3 p4 0.5 `shouldBe`-                decimalLatLongHeight 54.7835574 5.1949856 (metres 15000)-    describe "intersection" $ do-        it "returns nothing if both great arc are equals" $ do-            let ga = greatArc (decimalLatLong 51.885 0.235, decimalLatLong 52.885 1.235)-            (intersection ga ga :: Maybe LatLong) `shouldBe` Nothing-        it "returns nothing if both great arc are equals (opposite orientation)" $ do-            let ga1 = greatArc (decimalLatLong 51.885 0.235, decimalLatLong 52.885 1.235)-            let ga2 = greatArc (decimalLatLong 51.885 0.235, decimalLatLong 52.885 1.235)-            (intersection ga1 ga2 :: Maybe LatLong) `shouldBe` Nothing-        it "returns nothing if great circle intersection is outside either great arc" $ do-            let ga1 = greatArc (decimalLatLong 0 0, decimalLatLong 0 10)-            let ga2 = greatArc (decimalLatLong (-5) 5, decimalLatLong (-1) 5)-            (intersection ga1 ga2 :: Maybe LatLong) `shouldBe` Nothing-        it "returns nothing if great circle intersection is outside both great arcs" $ do-            let ga1 = greatArc (decimalLatLong 0 (-10), decimalLatLong 0 (-1))-            let ga2 = greatArc (decimalLatLong (-5) 5, decimalLatLong (-1) 5)-            (intersection ga1 ga2 :: Maybe LatLong) `shouldBe` Nothing-        it "returns the point where the two great arcs intersect" $ do-            let spd = kilometresPerHour 1000-            let t1 = Track (decimalLatLong 51.885 0.235) (decimalDegrees 108.63) spd-            let t2 = Track (decimalLatLong 49.008 2.549) (decimalDegrees 32.72) spd-            let oneHour = hours 1-            let ga1 = greatArc (t1, oneHour)-            let ga2 = greatArc (t2, oneHour)-            (intersection ga1 ga2 :: Maybe LatLong) `shouldBe`-                Just (decimalLatLong 50.9017225 4.494278333333333)-    describe "intersections" $ do-        it "returns nothing if both great circle are equals" $ do-            let gc = greatCircle (decimalLatLong 51.885 0.235, decimalDegrees 108.63)-            (intersections gc gc :: Maybe (LatLong, LatLong)) `shouldBe` Nothing-        it "returns nothing if both great circle are equals (opposite orientation)" $ do-            let gc1 = greatCircle (decimalLatLong 51.885 0.235, decimalLatLong 52.885 1.235)-            let gc2 = greatCircle (decimalLatLong 52.885 1.235, decimalLatLong 51.885 0.235)-            (intersections gc1 gc2 :: Maybe (LatLong, LatLong)) `shouldBe` Nothing-        it "returns the two points where the two great circles intersect" $ do-            let gc1 = greatCircle (decimalLatLong 51.885 0.235, decimalDegrees 108.63)-            let gc2 = greatCircle (decimalLatLong 49.008 2.549, decimalDegrees 32.72)-            let (i1, i2) = fromJust (intersections gc1 gc2)-            i1 `shouldBe` decimalLatLong 50.9017226 4.4942782-            i2 `shouldBe` antipode i1-    describe "isInsideSurface" $ do-        let p1 = decimalLatLong 45 1-        let p2 = decimalLatLong 45 2-        let p3 = decimalLatLong 46 1-        let p4 = decimalLatLong 46 2-        let p5 = decimalLatLong 45.1 1.1-        it "return False if polygon is empty" $ isInsideSurface p1 [] `shouldBe` False-        it "return False if polygon does not define at least a triangle" $-            isInsideSurface p1 [p1, p2] `shouldBe` False-        it "returns True if point is inside polygon" $ do-            let polygon = [p1, p2, p4, p3]-            isInsideSurface p5 polygon `shouldBe` True-        it "returns False if point is inside polygon" $ do-            let polygon = [p1, p2, p4, p3]-            let p = antipode p5-            isInsideSurface p polygon `shouldBe` False-        it "returns False if point is a vertex of the polygon" $ do-            let polygon = [p1, p2, p4, p3]-            isInsideSurface p1 polygon `shouldBe` False-        it "handles closed polygons" $ do-            let polygon = [p1, p2, p4, p3, p1]-            isInsideSurface p5 polygon `shouldBe` True-        it "handles concave polygons" $ do-            let malmo = decimalLatLong 55.6050 13.0038-            let ystad = decimalLatLong 55.4295 13.82-            let lund = decimalLatLong 55.7047 13.1910-            let helsingborg = decimalLatLong 56.0465 12.6945-            let kristianstad = decimalLatLong 56.0294 14.1567-            let polygon = [malmo, ystad, kristianstad, helsingborg, lund]-            let hoor = decimalLatLong 55.9295 13.5297-            let hassleholm = decimalLatLong 56.1589 13.7668-            isInsideSurface hoor polygon `shouldBe` True-            isInsideSurface hassleholm polygon `shouldBe` False-    describe "mean" $ do-        it "returns Nothing if no point is given" $ (mean [] :: Maybe NVector) `shouldBe` Nothing-        it "returns the unique given point" $ do-            let p = readLatLong "500359N0054253W"-            mean [p] `shouldBe` Just p-        it "returns the geographical mean" $ do-            let p1 = latLongHeight (readLatLong "500359N0054253W") (metres 15000.0)-            let p2 = latLongHeight (readLatLong "583838N0030412W") (metres 25000.0)-            let e = decimalLatLongHeight 54.3622869 (-4.5306725) zero-            mean [p1, p2] `shouldBe` Just e-        it "returns Nothing if list contains antipodal points" $ do-            let points =-                    [ decimalLatLong 45 1-                    , decimalLatLong 45 2-                    , decimalLatLong 46 2-                    , decimalLatLong 46 1-                    , antipode (decimalLatLong 45 2)-                    ]-            mean points `shouldBe` Nothing-    describe "surfaceDistance" $ do-        it "returns 0 if both points are equal" $ do-            let p = readLatLong "500359N1795959W"-            surfaceDistance p p r84 `shouldBe` zero-        it "returns the distance between 2 points" $ do-            let p1 = readLatLong "500359N0054253W"-            let p2 = readLatLong "583838N0030412W"-            surfaceDistance84 p1 p2 `shouldBe` metres 968854.8685-        it "handles singularity at the pole" $-            surfaceDistance northPole southPole r84 `shouldBe` kilometres 20015.114352200002-        it "handles the discontinuity at the Date Line" $ do-            let p1 = readLatLong "500359N1795959W"-            let p2 = readLatLong "500359N1795959E"-            surfaceDistance p1 p2 (meanRadius wgs84) `shouldBe` metres 39.6596
+ test/Data/Geo/Jord/GreatCircleSpec.hs view
@@ -0,0 +1,258 @@+module Data.Geo.Jord.GreatCircleSpec
+    ( spec
+    ) where
+
+import Control.Exception.Base (evaluate)
+import Control.Monad (join)
+import Data.Maybe (fromJust)
+
+import Test.Hspec
+
+import Data.Geo.Jord.GreatCircle
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec = do
+    describe "alongTrackDistance" $ do
+        it "returns a positive length when position is ahead start of great arc" $ do
+            let p = s84Pos 53.2611 (-0.7972) zero
+            let g = minorArc (s84Pos 53.3206 (-1.7297) zero) (s84Pos 53.1887 0.1334 zero)
+            fmap (alongTrackDistance p) g `shouldBe` Just (kilometres 62.3315791)
+        it "returns a negative length when position is ahead start of great arc" $ do
+            let p = s84Pos 53.3206 (-1.7297) zero
+            let g = minorArc (s84Pos 53.2611 (-0.7972) zero) (s84Pos 53.1887 0.1334 zero)
+            fmap (alongTrackDistance p) g `shouldBe` Just (kilometres (-62.329309979))
+        it "returns 0 when position is start of great arc" $ do
+            let p = s84Pos 53.2611 (-0.7972) zero
+            let g = minorArc p (s84Pos 53.1887 0.1334 zero)
+            fmap (alongTrackDistance p) g `shouldBe` Just zero
+    describe "crossTrackDistance" $ do
+        it "returns a negative length when position is left of great circle (bearing)" $ do
+            let p = s84Pos 53.2611 (-0.7972) zero
+            let gc = greatCircleHeadingOn (s84Pos 53.3206 (-1.7297) zero) (decimalDegrees 96.0)
+            crossTrackDistance p gc `shouldBe` metres (-305.665267)
+        it "returns a negative length when position is left of great circle" $ do
+            let p = s84Pos 53.2611 (-0.7972) zero
+            let gc = greatCircleThrough (s84Pos 53.3206 (-1.7297) zero) (s84Pos 53.1887 0.1334 zero)
+            fmap (crossTrackDistance p) gc `shouldBe` Just (metres (-307.549992))
+        it "returns a positve length when position is right of great circle (bearing)" $ do
+            let p = s84Pos 53.261111 (-1.797222) zero
+            let gc = greatCircleHeadingOn (s84Pos 53.320556 (-1.729722) zero) (decimalDegrees 96.02166667)
+            crossTrackDistance p gc `shouldBe` metres 7042.396068
+        it "returns a positive length when position is left of great circle" $ do
+            let p = antipode (s84Pos 53.2611 (-0.7972) zero)
+            let gc = greatCircleThrough (s84Pos 53.3206 (-1.7297) zero) (s84Pos 53.1887 0.1334 zero)
+            fmap (crossTrackDistance p) gc `shouldBe` Just (metres 307.549992)
+    describe "destination" $ do
+        it "return the given position if distance is 0 meter" $ do
+            let p0 = s84Pos 53.320556 (-1.729722) zero
+            destination p0 (decimalDegrees 96.0217) zero `shouldBe` p0
+        it "return the position along the great circle at distance and bearing" $ do
+            let p0 = s84Pos 53.320556 (-1.729722) (metres 15000.0)
+            let p1 = s84Pos 53.18826954833333 0.13327449055555557 (metres 15000.0)
+            destination p0 (decimalDegrees 96.0217) (metres 124800) `shouldBe` p1
+    describe "surfaceDistance" $ do
+        it "returns 0 if both points are equal" $ do
+            let p = s84Pos 50.066389 (-5.714722) (metres 15000.0)
+            surfaceDistance p p `shouldBe` zero
+        it "returns the distance between 2 points" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) zero
+            let p2 = s84Pos 58.643889 (-3.07) zero
+            surfaceDistance p1 p2 `shouldBe` metres 968854.878007
+        it "handles singularity at the pole" $
+            surfaceDistance (northPole S84) (southPole S84) `shouldBe` kilometres 20015.114352233
+        it "handles the discontinuity at the Date Line" $ do
+            let p1 = s84Pos 50.066389 (-179.999722) zero
+            let p2 = s84Pos 50.066389 179.999722 zero
+            surfaceDistance p1 p2 `shouldBe` metres 39.685092
+    describe "greatCircle through position" $
+        it "fails if both positions are equal" $
+        greatCircleThrough (s84Pos 3 154 zero) (s84Pos 3 154 zero) `shouldBe` Nothing
+    describe "finalBearing" $ do
+        it "returns the Nothing if both positions are the same (ignoring height)" $ do
+            let p = s84Pos 50.066389 (-5.714722) zero
+            finalBearing p p `shouldBe` Nothing
+            finalBearing p (s84Pos 50.066389 (-5.714722) (metres 10)) `shouldBe` Nothing
+        it "returns 0° if both positions have the same longitude (going north)" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) (metres 12000)
+            let p2 = s84Pos 58.643889 (-5.714722) (metres 5000)
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 180° if both positions have the same longitude (going south)" $ do
+            let p1 = s84Pos 58.643889 (-5.714722) (metres 5000)
+            let p2 = s84Pos 50.066389 (-5.714722) (metres 12000)
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 180)
+        it "returns 90° at the equator going east" $ do
+            let p1 = s84Pos 0 0 (metres 12000)
+            let p2 = s84Pos 0 1 (metres 5000)
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 90)
+        it "returns 270° at the equator going west" $ do
+            let p1 = s84Pos 0 1 (metres 12000)
+            let p2 = s84Pos 0 0 (metres 5000)
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 270)
+        it "returns the final bearing in compass angle" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) zero
+            let p2 = s84Pos 58.643889 (-3.07) zero
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 11.27520031611111)
+        it "returns the final bearing in compass angle" $ do
+            let p1 = s84Pos 58.643889 (-3.07) zero
+            let p2 = s84Pos 50.066389 (-5.714722) zero
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 189.1198173275)
+        it "returns the final bearing in compass angle" $ do
+            let p1 = s84Pos (-53.994722) (-25.9875) zero
+            let p2 = s84Pos 54 154 zero
+            finalBearing p1 p2 `shouldBe` Just (decimalDegrees 125.68508662305555)
+    describe "initialBearing" $ do
+        it "returns Nothing if both positions are the same (ignoring height)" $ do
+            let p = s84Pos 50.066389 (-179.999722) zero
+            initialBearing p p `shouldBe` Nothing
+            initialBearing p (s84Pos 50.066389 (-179.999722) (metres 100)) `shouldBe` Nothing
+        it "returns 0° if both positions have the same longitude (going north)" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) (metres 12000)
+            let p2 = s84Pos 58.643889 (-5.714722) (metres 12000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 180° if both positions have the same longitude (going south)" $ do
+            let p1 = s84Pos 58.643889 (-5.714722) (metres 12000)
+            let p2 = s84Pos 50.066389 (-5.714722) (metres 12000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 180)
+        it "returns 90° at the equator going east" $ do
+            let p1 = s84Pos 0 0 (metres 12000)
+            let p2 = s84Pos 0 1 (metres 5000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 90)
+        it "returns 270° at the equator going west" $ do
+            let p1 = s84Pos 0 1 (metres 12000)
+            let p2 = s84Pos 0 0 (metres 5000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 270)
+        it "returns 0° at the prime meridian going north" $ do
+            let p1 = s84Pos 50 0 zero
+            let p2 = s84Pos 58 0 zero
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 180° at the prime meridian going south" $ do
+            let p1 = s84Pos 58 0 zero
+            let p2 = s84Pos 50 0 zero
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 180)
+        it "returns 0° at the date line going north" $ do
+            let p1 = s84Pos 50 180 zero
+            let p2 = s84Pos 58 180 zero
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 180° at the date line going south" $ do
+            let p1 = s84Pos 58 180 zero
+            let p2 = s84Pos 50 180 zero
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 180)
+        it "returns 0° going from the south pole to the north pole" $ do
+            let p1 = southPole S84
+            let p2 = northPole S84
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 0° going from the north pole to the south pole" $ do
+            let p1 = northPole S84
+            let p2 = southPole S84
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns 0° going from the south pole to anywhere on the date line" $ do
+            let p1 = southPole S84
+            let p2 = s84Pos 50 180 zero
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 0)
+        it "returns the initial bearing in compass angle" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) (metres 12000)
+            let p2 = s84Pos 58.643889 (-3.07) (metres 5000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 9.1198173275)
+        it "returns the initial bearing in compass angle" $ do
+            let p1 = s84Pos 58.643889 (-3.07) (metres 12000)
+            let p2 = s84Pos 50.066389 (-5.714722) (metres 5000)
+            initialBearing p1 p2 `shouldBe` Just (decimalDegrees 191.27520031611112)
+    describe "interpolate" $ do
+        let p1 = s84Pos 44 44 zero
+        let p2 = s84Pos 46 46 zero
+        it "fails if f < 0.0" $
+            evaluate (interpolate p1 p2 (-0.5)) `shouldThrow` errorCall "fraction must be in range [0..1], was -0.5"
+        it "fails if f > 1.0" $
+            evaluate (interpolate p1 p2 1.1) `shouldThrow` errorCall "fraction must be in range [0..1], was 1.1"
+        it "returns p0 if f == 0" $ interpolate p1 p2 0.0 `shouldBe` p1
+        it "returns p1 if f == 1" $ interpolate p1 p2 1.0 `shouldBe` p2
+        it "returns the interpolated position" $ do
+            let p3 = s84Pos 53.479444 (-2.245278) (metres 10000)
+            let p4 = s84Pos 55.605833 13.035833 (metres 20000)
+            interpolate p3 p4 0.5 `shouldBe` s84Pos 54.78355703138889 5.194985318055555 (metres 15000)
+    describe "isInsideSurface" $ do
+        let p1 = s84Pos 45 1 zero
+        let p2 = s84Pos 45 2 zero
+        let p3 = s84Pos 46 1 zero
+        let p4 = s84Pos 46 2 zero
+        let p5 = s84Pos 45.1 1.1 zero
+        it "return False if polygon is empty" $ isInsideSurface p1 [] `shouldBe` False
+        it "return False if polygon does not define at least a triangle" $ isInsideSurface p1 [p1, p2] `shouldBe` False
+        it "returns True if position is inside polygon" $ do
+            let polygon = [p1, p2, p4, p3]
+            isInsideSurface p5 polygon `shouldBe` True
+        it "returns False if position is inside polygon" $ do
+            let polygon = [p1, p2, p4, p3]
+            let p = antipode p5
+            isInsideSurface p polygon `shouldBe` False
+        it "returns False if position is a vertex of the polygon" $ do
+            let polygon = [p1, p2, p4, p3]
+            isInsideSurface p1 polygon `shouldBe` False
+        it "handles closed polygons" $ do
+            let polygon = [p1, p2, p4, p3, p1]
+            isInsideSurface p5 polygon `shouldBe` True
+        it "handles concave polygons" $ do
+            let malmo = s84Pos 55.6050 13.0038 zero
+            let ystad = s84Pos 55.4295 13.82 zero
+            let lund = s84Pos 55.7047 13.1910 zero
+            let helsingborg = s84Pos 56.0465 12.6945 zero
+            let kristianstad = s84Pos 56.0294 14.1567 zero
+            let polygon = [malmo, ystad, kristianstad, helsingborg, lund]
+            let hoor = s84Pos 55.9295 13.5297 zero
+            let hassleholm = s84Pos 56.1589 13.7668 zero
+            isInsideSurface hoor polygon `shouldBe` True
+            isInsideSurface hassleholm polygon `shouldBe` False
+    describe "intersection" $ do
+        it "returns nothing if both great arc are equals" $ do
+            let a = minorArc (s84Pos 51.885 0.235 zero) (s84Pos 52.885 1.235 zero)
+            join (intersection <$> a <*> a) `shouldBe` Nothing
+        it "returns nothing if both great arc are equals (opposite orientation)" $ do
+            let a1 = minorArc (s84Pos 51.885 0.235 zero) (s84Pos 52.885 1.235 zero)
+            let a2 = minorArc (s84Pos 52.885 1.235 zero) (s84Pos 51.885 0.235 zero)
+            join (intersection <$> a1 <*> a2) `shouldBe` Nothing
+        it "returns nothing if great circle intersection is outside either great arc" $ do
+            let a1 = minorArc (s84Pos 0 0 zero) (s84Pos 0 10 zero)
+            let a2 = minorArc (s84Pos (-5) 5 zero) (s84Pos (-1) 5 zero)
+            join (intersection <$> a1 <*> a2) `shouldBe` Nothing
+        it "returns nothing if great circle intersection is outside both great arcs" $ do
+            let a1 = minorArc (s84Pos 0 (-10) zero) (s84Pos 0 (-1) zero)
+            let a2 = minorArc (s84Pos (-5) 5 zero) (s84Pos (-1) 5 zero)
+            join (intersection <$> a1 <*> a2) `shouldBe` Nothing
+        it "returns the point where the two great arcs intersect" $ do
+            let a1 = minorArc (s84Pos 51.885 0.235 zero) (s84Pos 48.269 13.093 zero)
+            let a2 = minorArc (s84Pos 49.008 2.549 zero) (s84Pos 56.283 11.304 zero)
+            join (intersection <$> a1 <*> a2) `shouldBe` Just (s84Pos 50.901738961111114 4.49418117 zero)
+    describe "intersections" $ do
+        it "returns nothing if both great circle are equals" $ do
+            let gc = greatCircleHeadingOn (s84Pos 51.885 0.235 zero) (decimalDegrees 108.63)
+            intersections gc gc `shouldBe` Nothing
+        it "returns nothing if both great circle are equals (opposite orientation)" $ do
+            let gc1 = greatCircleThrough (s84Pos 51.885 0.235 zero) (s84Pos 52.885 1.235 zero)
+            let gc2 = greatCircleThrough (s84Pos 52.885 1.235 zero) (s84Pos 51.885 0.235 zero)
+            join (intersections <$> gc1 <*> gc2) `shouldBe` Nothing
+        it "returns the two positions where the two great circles intersects" $ do
+            let gc1 = greatCircleHeadingOn (s84Pos 51.885 0.235 zero) (decimalDegrees 108.63)
+            let gc2 = greatCircleHeadingOn (s84Pos 49.008 2.549 zero) (decimalDegrees 32.72)
+            let (i1, i2) = fromJust (intersections gc1 gc2)
+            i1 `shouldBe` s84Pos 50.90172260888889 4.494278278888889 zero
+            i2 `shouldBe` antipode i1
+    describe "mean" $ do
+        it "returns Nothing if no position is given" $ (mean [] :: (Maybe (Position S84))) `shouldBe` Nothing
+        it "returns the unique given position" $ do
+            let p = s84Pos 50.066389 (-5.714722) zero
+            mean [p] `shouldBe` Just p
+        it "returns the geographical mean" $ do
+            let p1 = s84Pos 50.066389 (-5.714722) (metres 15000.0)
+            let p2 = s84Pos 58.643889 (-3.07) (metres 25000.0)
+            let e = s84Pos 54.3622869375 (-4.530672405) zero
+            mean [p1, p2] `shouldBe` Just e
+        it "returns Nothing if list contains antipodal positions" $ do
+            let points =
+                    [ s84Pos 45 1 zero
+                    , s84Pos 45 2 zero
+                    , s84Pos 46 2 zero
+                    , s84Pos 46 1 zero
+                    , antipode (s84Pos 45 2 zero)
+                    ]
+            mean points `shouldBe` Nothing
test/Data/Geo/Jord/KinematicsSpec.hs view
@@ -1,199 +1,211 @@-module Data.Geo.Jord.KinematicsSpec-    ( spec-    ) where--import Data.Geo.Jord-import Data.Maybe (fromJust)-import Test.Hspec--spec :: Spec-spec =-    describe "kinematics" $ do-        describe "position" $ do-            it "computes position at t from p0, bearing and speed" $ do-                let p0 = latLongHeight (readLatLong "531914N0014347W") (metres 15000)-                let p1 = decimalLatLongHeight 53.1882691 0.1332741 (metres 15000)-                let t = Track p0 (decimalDegrees 96.0217) (kilometresPerHour 124.8)-                position84 t (hours 1) `shouldBe` p1-            it "handles poles" $-                -- distance between poles assuming a spherical earth (WGS84) = 20015.114352200002km-                -- track at north pole travelling at 20015.114352200002km/h and true north reaches the-                -- south pole after 1 hour.-             do-                let t = Track (decimalLatLong 90 0) zero (kilometresPerHour 20015.114352200002)-                position84 t (hours 1) `shouldBe` decimalLatLong (-90) 180.0-            it "return p0 if speed is 0" $ do-                let p0 = latLongHeight (readLatLong "531914N0014347W") (metres 15000)-                let t = Track p0 (decimalDegrees 96.0217) zero-                position84 t (hours 1) `shouldBe` p0-            it "return p0 if duration is 0" $ do-                let p0 = latLongHeight (readLatLong "531914N0014347W") (metres 15000)-                let t = Track p0 (decimalDegrees 96.0217) (kilometresPerHour 124.8)-                position84 t zero `shouldBe` p0-        describe "cpa" $ do-            it "handles trailing tracks" $ do-                let p1 = decimalLatLong 20 30-                let px = destination84 p1 (decimalDegrees 20) (kilometres 1)-                let p2 = interpolate p1 px 0.25-                let b1 = fromJust (initialBearing p1 px)-                let b2 = fromJust (initialBearing p2 px)-                let t1 = Track p1 b1 (knots 400)-                let t2 = Track p2 b2 (knots 400)-                let c = cpa84 t1 t2-                -- any time is correct but it should be close to zero since that's-                -- our initial value-                fmap (\r -> toMilliseconds (cpaTime r) < 5000) c `shouldBe` Just True-                fmap cpaDistance c `shouldBe` Just (metres 250.0036)-            it "handles heading tracks" $ do-                let p1 = decimalLatLong 20 30-                let p2 = decimalLatLong 21 31-                let b1 = fromJust (initialBearing p1 p2)-                let b2 = fromJust (initialBearing p2 p1)-                let t1 = Track p1 b1 (knots 400)-                let t2 = Track p2 b2 (knots 400)-                let c = cpa84 t1 t2-                -- distance between p1 and p2 = 152.354309 km-                -- speed = 740.8 km/h-                -- time = 152.354309 / 740.8 / 2-                fmap cpaTime c `shouldBe` Just (milliseconds 370191)-                fmap cpaDistance c `shouldBe` Just zero-            it "handles tracks at the same position" $ do-                let p = decimalLatLong 20 30-                let t1 = Track p (decimalDegrees 45) (knots 300)-                let t2 = Track p (decimalDegrees 135) (knots 500)-                let c = cpa84 t1 t2-                fmap cpaTime c `shouldBe` Just zero-                fmap cpaDistance c `shouldBe` Just zero-            it "computes time to CPA, positions and distance at CPA" $ do-                let p1 = decimalLatLong 20 (-60)-                let b1 = decimalDegrees 10-                let s1 = knots 15-                let p2 = decimalLatLong 34 (-50)-                let b2 = decimalDegrees 220-                let s2 = knots 300-                let t1 = Track p1 b1 s1-                let t2 = Track p2 b2 s2-                let c = cpa84 t1 t2-                fmap cpaTime c `shouldBe` Just (milliseconds 11396155)-                fmap cpaDistance c `shouldBe` Just (kilometres 124.2317453)-            it "returns Nothing if time to CPA is in the past" $ do-                let t1 = Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400)-                let t2 = Track (decimalLatLong 30.01 30) (decimalDegrees 315) (knots 400)-                cpa84 t1 t2 `shouldBe` Nothing-        describe "intercept" $ do-            it "returns Nothing if target and interceptor are at the same position" $-                intercept84-                    (Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400))-                    (decimalLatLong 30 30) `shouldBe`-                Nothing-            it "returns Nothing if interceptor is behing target" $ do-                let t = Track (decimalLatLong 45 67) (decimalDegrees 54) (knots 400)-                let ip = decimalLatLong 44 66-                intercept84 t ip `shouldBe` Nothing-            it "handles interceptor on the great circle of target and in front" $ do-                let tp = decimalLatLong 20 30-                let px = destination84 tp (decimalDegrees 20) (kilometres 1)-                let ip = interpolate tp px 0.25-                let b = fromJust (initialBearing tp px)-                let t = Track tp b (knots 400)-                let i = intercept84 t ip-                fmap interceptorSpeed i `shouldBe` Just zero-                fmap interceptPosition i `shouldBe` Just ip-                fmap interceptTime i `shouldBe` Just (seconds 1.215)-            it "returns Nothing if interceptor is behing target" $ do-                let t = Track (decimalLatLong 45 67) (decimalDegrees 181) (knots 400)-                let ip = decimalLatLong 44 66-                let i = intercept84 t ip-                fmap interceptorSpeed i `shouldBe` Just (knots 228.5538171521)-                fmap interceptTime i `shouldBe` Just (seconds 808.770)-                let interceptor =-                        Track-                            ip-                            (fromJust (fmap interceptorBearing i))-                            (fromJust (fmap interceptorSpeed i))-                fmap interceptPosition i `shouldBe`-                    Just (position84 interceptor (fromJust (fmap interceptTime i)))-            it "returns the minimum speed required for intercept to take place" $ do-                let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)-                let ip = decimalLatLong 20 (-60)-                let i = intercept84 t ip-                fmap interceptorSpeed i `shouldBe` Just (knots 52.633367756059)-                fmap interceptTime i `shouldBe` Just (seconds 5993.831)-                let interceptor =-                        Track-                            ip-                            (fromJust (fmap interceptorBearing i))-                            (fromJust (fmap interceptorSpeed i))-                fmap interceptPosition i `shouldBe`-                    Just (position84 interceptor (fromJust (fmap interceptTime i)))-        describe "interceptBySpeed" $ do-            it "returns Nothing if target and interceptor are at the same position" $-                interceptBySpeed84-                    (Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400))-                    (decimalLatLong 30 30)-                    (knots 400) `shouldBe`-                Nothing-            it "returns Nothing if interceptor speed is below minimum speed" $ do-                let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)-                let ip = decimalLatLong 20 (-60)-                interceptBySpeed84 t ip (knots 50) `shouldBe` Nothing-            it "returns the speed needed for intercept to take place" $ do-                let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)-                let ip = decimalLatLong 20 (-60)-                let i = interceptBySpeed84 t ip (knots 700)-                fmap interceptTime i `shouldBe` Just (seconds 2764.692)-                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 25.93541277)-                fmap interceptDistance i `shouldBe` Just (kilometres 995.5960805999999)-            it "returns the same as intercept when called with minimum speed" $ do-                let t = Track (decimalLatLong 45 50) (decimalDegrees 54) (knots 500)-                let ip = decimalLatLong 70 30-                let mi = intercept84 t ip-                let i = interceptBySpeed84 t ip (fromJust (fmap interceptorSpeed mi))-                fmap interceptTime i `shouldBe` fmap interceptTime mi-        describe "interceptByTime" $ do-            it "returns Nothing if duration is zero" $-                interceptByTime84-                    (Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400))-                    (decimalLatLong 34 (-50))-                    zero `shouldBe`-                Nothing-            it "returns Nothing if duration is negative" $-                interceptByTime84-                    (Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400))-                    (decimalLatLong 34 (-50))-                    (seconds (-1)) `shouldBe`-                Nothing-            it "returns Nothing if target and interceptor are at the same position" $-                interceptByTime84-                    (Track (decimalLatLong 30 30) (decimalDegrees 45) (knots 400))-                    (decimalLatLong 30 30)-                    (seconds 10) `shouldBe`-                Nothing-            it "returns the speed needed for intercept to take place" $ do-                let t = Track (decimalLatLong 34 (-50)) (decimalDegrees 220) (knots 600)-                let ip = decimalLatLong 20 (-60)-                let d = seconds 2700-                let i = interceptByTime84 t ip d-                fmap interceptorSpeed i `shouldBe` Just (knots 730.959238)-                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 26.1199030)-                fmap interceptPosition i `shouldBe` Just (decimalLatLong 28.1366797 (-55.4559475))-                fmap interceptDistance i `shouldBe` Just (metres 1015302.3815)-                fmap interceptTime i `shouldBe` Just (seconds 2700)-            it "handles the poles" $-                -- distance between poles assuming a spherical earth (WGS84) = 20015.114352200002km-                -- target at north pole travelling at 500km/h and true north can be intercepted from-                -- the south pole by an interceptor travelling at ~ 19515.114352200002km/h and 180 degrees.-             do-                let t = Track (decimalLatLong 90 0) zero (kilometresPerHour 500)-                let ip = decimalLatLong (-90) 0-                let i = interceptByTime84 t ip (seconds 3600)-                fmap interceptorSpeed i `shouldBe` Just (kilometresPerHour 19515.11434)-                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 180)-            it "handles the interceptor being at the intercept position at t" $ do-                let tp = decimalLatLong 34 (-50)-                let t = Track tp (decimalDegrees 220) (knots 600)-                let d = seconds 3600-                let ip = position84 t d-                let i = interceptByTime84 t ip d-                fmap interceptorSpeed i `shouldBe` Just zero+module Data.Geo.Jord.KinematicsSpec
+    ( spec
+    ) where
+
+import Data.Maybe (fromJust)
+
+import Test.Hspec
+
+import Data.Geo.Jord.GreatCircle
+import Data.Geo.Jord.Kinematics
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec =
+    describe "kinematics" $ do
+        describe "trackPositionAfter" $ do
+            it "computes position at t from p0, bearing and speed" $ do
+                let p0 = s84Pos 53.320556 (-1.729722) (metres 15000)
+                let p1 = s84Pos 53.18826954833333 0.13327449083333334 (metres 15000)
+                let t = Track p0 (decimalDegrees 96.0217) (kilometresPerHour 124.8)
+                trackPositionAfter t (hours 1) `shouldBe` p1
+            it "handles crossing the date line" $
+                -- distance at equator between 2 positions separated by 180 degrees assuming a spherical
+                -- earth (from WGS84) = 20015.114352233km
+                -- track at 0N1E travelling at 20015.114352233km/h and 90 degrees reaches 0N179W after 1 hour.
+             do
+                let p0 = s84Pos 0 1 zero
+                let t = Track p0 (decimalDegrees 90) (kilometresPerHour 20015.114352233)
+                let p1 = trackPositionAfter t (hours 1)
+                surfaceDistance p1 (s84Pos 0 (-179) zero) < metres 0.001 `shouldBe` True
+            it "handles poles" $
+                -- distance between poles assuming a spherical earth (from WGS84) = 20015.114352233km
+                -- track at north pole travelling at 20015.114352233km/h and true north reaches the
+                -- south pole after 1 hour.
+             do
+                let t = Track (northPole S84) zero (kilometresPerHour 20015.114352233)
+                let p1 = trackPositionAfter t (hours 1)
+                surfaceDistance p1 (southPole S84) < metres 0.001 `shouldBe` True
+            it "return p0 if speed is 0" $ do
+                let p0 = s84Pos 53.320556 (-1.729722) (metres 15000)
+                let t = Track p0 (decimalDegrees 96.0217) zero
+                trackPositionAfter t (hours 1) `shouldBe` p0
+            it "return p0 if duration is 0" $ do
+                let p0 = s84Pos 53.320556 (-1.729722) (metres 15000)
+                let t = Track p0 (decimalDegrees 96.0217) (kilometresPerHour 124.8)
+                trackPositionAfter t zero `shouldBe` p0
+        describe "cpa" $ do
+            it "returns nothing for trailing tracks at same speed" $ do
+                let p1 = s84Pos 20 30 zero
+                let px = destination p1 (decimalDegrees 20) (kilometres 1)
+                let p2 = interpolate p1 px 0.25
+                let b1 = fromJust (initialBearing p1 px)
+                let b2 = fromJust (initialBearing p2 px)
+                let t1 = Track p1 b1 (knots 400)
+                let t2 = Track p2 b2 (knots 400)
+                cpa t1 t2 `shouldBe` Nothing
+            it "returns nothing for trailing tracks with track ahead escaping" $ do
+                let p1 = s84Pos 20 30 zero
+                let px = destination p1 (decimalDegrees 20) (kilometres 1)
+                let p2 = interpolate p1 px 0.25
+                let b1 = fromJust (initialBearing p1 px)
+                let b2 = fromJust (initialBearing p2 px)
+                let t1 = Track p1 b1 (knots 400)
+                let t2 = Track p2 b2 (knots 401)
+                cpa t1 t2 `shouldBe` Nothing
+            it "handles trailing tracks with track behind catching up" $ do
+                let p1 = s84Pos 20 30 zero
+                let px = destination p1 (decimalDegrees 20) (kilometres 1)
+                let p2 = interpolate p1 px 0.25
+                let b1 = fromJust (initialBearing p1 px)
+                let b2 = fromJust (initialBearing p2 px)
+                let t1 = Track p1 b1 (knots 401)
+                let t2 = Track p2 b2 (knots 400)
+                let c = cpa t1 t2
+                fmap cpaTime c `shouldBe` Just (seconds 485.953)
+                fmap cpaDistance c `shouldBe` Just (metres 4.293e-3) -- close to 0
+            it "handles heading tracks" $ do
+                let p1 = s84Pos 20 30 zero
+                let p2 = s84Pos 21 31 zero
+                let b1 = fromJust (initialBearing p1 p2)
+                let b2 = fromJust (initialBearing p2 p1)
+                let t1 = Track p1 b1 (knots 400)
+                let t2 = Track p2 b2 (knots 400)
+                let c = cpa t1 t2
+                -- distance between p1 and p2 = 152.354309 km
+                -- speed = 740.8 km/h
+                -- time = 152.354309 / 740.8 / 2
+                fmap cpaTime c `shouldBe` Just (milliseconds 370191)
+                fmap cpaDistance c `shouldBe` Just zero
+            it "handles tracks at the same position" $ do
+                let p = s84Pos 20 30 zero
+                let t1 = Track p (decimalDegrees 45) (knots 300)
+                let t2 = Track p (decimalDegrees 135) (knots 500)
+                let c = cpa t1 t2
+                fmap cpaTime c `shouldBe` Just zero
+                fmap cpaDistance c `shouldBe` Just zero
+            it "computes time to CPA, positions and distance at CPA" $ do
+                let p1 = s84Pos 20 (-60) zero
+                let b1 = decimalDegrees 10
+                let s1 = knots 15
+                let p2 = s84Pos 34 (-50) (metres 10000)
+                let b2 = decimalDegrees 220
+                let s2 = knots 300
+                let t1 = Track p1 b1 s1
+                let t2 = Track p2 b2 s2
+                let c = cpa t1 t2
+                fmap cpaTime c `shouldBe` Just (milliseconds 11396155)
+                fmap cpaDistance c `shouldBe` Just (kilometres 124.231730834)
+                fmap cpaPosition1 c `shouldBe` Just (s84Pos 20.778789303333333 (-59.85311827861111) zero)
+                fmap cpaPosition2 c `shouldBe` Just (s84Pos 21.402367759166665 (-60.846710862222224) (metres 10000))
+            it "returns Nothing if time to CPA is in the past" $ do
+                let t1 = Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400)
+                let t2 = Track (s84Pos 30.01 30 zero) (decimalDegrees 315) (knots 400)
+                cpa t1 t2 `shouldBe` Nothing
+        describe "intercept" $ do
+            it "returns Nothing if target and interceptor are at the same position" $
+                intercept (Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400)) (s84Pos 30 30 zero) `shouldBe`
+                Nothing
+            it "returns Nothing if interceptor is behind target" $ do
+                let t = Track (s84Pos 45 67 zero) (decimalDegrees 54) (knots 400)
+                let ip = s84Pos 44 66 zero
+                intercept t ip `shouldBe` Nothing
+            it "handles interceptor on the great circle of target and in front" $ do
+                let tp = s84Pos 20 30 zero
+                let b = decimalDegrees 12
+                let t = Track tp b (knots 400)
+                let ip = trackPositionAfter t (minutes 1)
+                let i = intercept t ip
+                fmap interceptorSpeed i `shouldBe` Just zero
+                fmap interceptDistance i `shouldBe` Just zero
+                fmap interceptPosition i `shouldBe` Just ip
+                fmap interceptTime i `shouldBe` Just (minutes 1)
+            it "returns the minimum speed required for intercept to take place" $ do
+                let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+                let ip = s84Pos 20 (-60) zero
+                let i = intercept t ip
+                fmap interceptorSpeed i `shouldBe` Just (knots 52.63336879049676)
+                fmap interceptTime i `shouldBe` Just (seconds 5993.831)
+                let interceptor = Track ip (fromJust (fmap interceptorBearing i)) (fromJust (fmap interceptorSpeed i))
+                let ep = trackPositionAfter interceptor (fromJust (fmap interceptTime i))
+                let ap = fmap interceptPosition i
+                let d = fmap (surfaceDistance ep) ap
+                fmap (<= metres 0.001) d `shouldBe` Just True
+        describe "interceptBySpeed" $ do
+            it "returns Nothing if target and interceptor are at the same position" $
+                interceptBySpeed
+                    (Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400))
+                    (s84Pos 30 30 zero)
+                    (knots 400) `shouldBe`
+                Nothing
+            it "returns Nothing if interceptor speed is below minimum speed" $ do
+                let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+                let ip = s84Pos 20 (-60) zero
+                interceptBySpeed t ip (knots 50) `shouldBe` Nothing
+            it "returns the speed needed for intercept to take place" $ do
+                let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+                let ip = s84Pos 20 (-60) zero
+                let i = interceptBySpeed t ip (knots 700)
+                fmap interceptTime i `shouldBe` Just (seconds 2764.692)
+                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 25.93541248472222)
+                fmap interceptDistance i `shouldBe` Just (kilometres 995.596069189)
+            it "returns the same as intercept when called with minimum speed" $ do
+                let t = Track (s84Pos 45 50 zero) (decimalDegrees 54) (knots 500)
+                let ip = s84Pos 70 30 zero
+                let mi = intercept t ip
+                let i = interceptBySpeed t ip (fromJust (fmap interceptorSpeed mi))
+                fmap interceptTime i `shouldBe` fmap interceptTime mi
+        describe "interceptByTime" $ do
+            it "returns Nothing if duration is zero" $
+                interceptByTime (Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400)) (s84Pos 34 (-50) zero) zero `shouldBe`
+                Nothing
+            it "returns Nothing if duration is negative" $
+                interceptByTime
+                    (Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400))
+                    (s84Pos 34 (-50) zero)
+                    (seconds (-1)) `shouldBe`
+                Nothing
+            it "returns Nothing if target and interceptor are at the same position" $
+                interceptByTime
+                    (Track (s84Pos 30 30 zero) (decimalDegrees 45) (knots 400))
+                    (s84Pos 30 30 zero)
+                    (seconds 10) `shouldBe`
+                Nothing
+            it "returns the speed needed for intercept to take place" $ do
+                let t = Track (s84Pos 34 (-50) zero) (decimalDegrees 220) (knots 600)
+                let ip = s84Pos 20 (-60) zero
+                let d = seconds 2700
+                let i = interceptByTime t ip d
+                fmap interceptorSpeed i `shouldBe` Just (knots 730.9592213822895)
+                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 26.119902564166665)
+                fmap interceptPosition i `shouldBe` Just (s84Pos 28.136679674444444 (-55.455947612222225) zero)
+                fmap interceptDistance i `shouldBe` Just (kilometres 1015.302358852)
+                fmap interceptTime i `shouldBe` Just (seconds 2700)
+            it "handles the poles" $
+                -- distance between poles assuming a spherical earth (WGS84) = 20015.114352200002km
+                -- target at north pole travelling at 500km/h and true north can be intercepted from
+                -- the south pole by an interceptor travelling at ~ 19515.114352200002km/h and 0 degrees.
+             do
+                let t = Track (northPole S84) zero (kilometresPerHour 500)
+                let ip = southPole S84
+                let i = interceptByTime t ip (seconds 3600)
+                fmap interceptorSpeed i `shouldBe` Just (kilometresPerHour 19515.114352)
+                fmap interceptorBearing i `shouldBe` Just (decimalDegrees 0)
+            it "handles the interceptor being at the intercept position at t" $ do
+                let tp = s84Pos 34 (-50) zero
+                let t = Track tp (decimalDegrees 220) (knots 600)
+                let d = seconds 3600
+                let ip = trackPositionAfter t d
+                let i = interceptByTime t ip d
+                fmap interceptorSpeed i `shouldBe` Just zero
                 fmap interceptorBearing i `shouldBe` initialBearing ip tp
− test/Data/Geo/Jord/LatLongSpec.hs 
@@ -1,63 +0,0 @@-module Data.Geo.Jord.LatLongSpec
-    ( spec
-    ) where
-
-import Data.Geo.Jord
-import Test.Hspec
-
-spec :: Spec
-spec = do
-    describe "Reading valid DMS text" $ do
-        it "reads 553621N0130002E" $
-            readLatLong "553621N0130002E" `shouldBe` decimalLatLong 55.6058333 13.0005555
-        it "reads 55°36'21''N 013°00'02''E" $
-            readLatLong "55°36'21''N 013°00'02''E" `shouldBe` decimalLatLong 55.6058333 13.0005555
-        it "reads 5536N01300E" $ readLatLong "5536N01300E" `shouldBe` decimalLatLong 55.6 13.0
-        it "reads 55N013E" $ readLatLong "55N013E" `shouldBe` decimalLatLong 55.0 13.0
-        it "reads 011659S0364900E" $
-            readLatLong "011659S0364900E" `shouldBe` decimalLatLong (-1.2830555) 36.8166666
-        it "reads 0116S03649E" $
-            readLatLong "0116S03649E" `shouldBe` decimalLatLong (-1.2666666) 36.8166666
-        it "reads 1°16'S,36°49'E" $
-            readLatLong "1°16'S,36°49'E" `shouldBe` decimalLatLong (-1.2666666) 36.8166666
-        it "reads 01S036E" $ readLatLong "01S036E" `shouldBe` decimalLatLong (-1.0) 36.0
-        it "reads 473622N1221955W" $
-            readLatLong "473622N1221955W" `shouldBe` decimalLatLong 47.6061111 (-122.3319444)
-        it "reads 4736N12219W" $
-            readLatLong "4736N12219W" `shouldBe` decimalLatLong 47.6 (-122.3166666)
-        it "reads 47N122W" $ readLatLong "47N122W" `shouldBe` decimalLatLong 47.0 (-122.0)
-        it "reads 47°N 122°W" $ readLatLong "47°N 122°W" `shouldBe` decimalLatLong 47.0 (-122.0)
-        it "reads 544807S0681811W" $
-            readLatLong "544807S0681811W" `shouldBe` decimalLatLong (-54.8019444) (-68.3030555)
-        it "reads 5448S06818W" $ readLatLong "5448S06818W" `shouldBe` decimalLatLong (-54.8) (-68.3)
-        it "reads 54S068W" $ readLatLong "54S068W" `shouldBe` decimalLatLong (-54.0) (-68.0)
-    describe "Reading invalid DMS text" $ do
-        it "fails to read 553621K0130002E" $
-            readLatLongE "553621K0130002E" `shouldBe` Left "couldn't read geo pos 553621K0130002E"
-        it "fails to read 011659S0364900Z" $
-            readLatLongE "011659S0364900Z" `shouldBe` Left "couldn't read geo pos 011659S0364900Z"
-        it "fails to read 4736221221955W" $
-            readLatLongE "4736221221955W" `shouldBe` Left "couldn't read geo pos 4736221221955W"
-        it "fails to read 54480S0681811W" $
-            readLatLongE "54480S0681811W" `shouldBe` Left "couldn't read geo pos 54480S0681811W"
-        it "fails to read 553621N013000E" $
-            readLatLongE "553621N013000E" `shouldBe` Left "couldn't read geo pos 553621N013000E"
-        it "fails to read 914807S0681811W" $
-            readLatLongE "914807S0681811W" `shouldBe` Left "couldn't read geo pos 914807S0681811W"
-        it "fails to read 544807S1811811W" $
-            readLatLongE "544807S1811811W" `shouldBe` Left "couldn't read geo pos 544807S1811811W"
-        it "fails to read 546007S1801811W" $
-            readLatLongE "546007S1801811W" `shouldBe` Left "couldn't read geo pos 546007S1801811W"
-        it "fails to read 545907S1801860W" $
-            readLatLongE "545907S1801860W" `shouldBe` Left "couldn't read geo pos 545907S1801860W"
-    describe "Showing geographic positions" $ do
-        it "shows the N/E position formatted in DMS with symbols" $
-            show (decimalLatLong 55.60583333 13.00055556) `shouldBe` "55°36'21.000\"N,13°0'2.000\"E"
-        it "shows the S/E position formatted in DMS with symbols" $
-            show (decimalLatLong (-1.28305556) 36.81666) `shouldBe` "1°16'59.000\"S,36°48'59.976\"E"
-        it "shows the N/W position formatted in DMS with symbols" $
-            show (decimalLatLong 47.60611 (-122.33194)) `shouldBe`
-            "47°36'21.996\"N,122°19'54.984\"W"
-        it "shows the S/W position formatted in DMS with symbols" $
-            show (decimalLatLong (-54.80194) (-68.30305)) `shouldBe`
-            "54°48'6.984\"S,68°18'10.980\"W"
test/Data/Geo/Jord/LengthSpec.hs view
@@ -2,19 +2,21 @@     ( spec
     ) where
 
-import Data.Geo.Jord
 import Test.Hspec
 
+import Data.Geo.Jord.Length
+import Data.Geo.Jord.Quantity
+
 spec :: Spec
 spec = do
     describe "Reading valid lengths" $ do
-        it "reads -15.2m" $ readLength "-15.2m" `shouldBe` metres (-15.2)
-        it "reads 154km" $ readLength "154km" `shouldBe` kilometres 154
-        it "reads 1000nm" $ readLength "1000nm" `shouldBe` nauticalMiles 1000
-        it "reads 25000ft" $ readLength "25000ft" `shouldBe` feet 25000
+        it "reads -15.2m" $ readLength "-15.2m" `shouldBe` Just (metres (-15.2))
+        it "reads 154km" $ readLength "154km" `shouldBe` Just (kilometres 154)
+        it "reads 1000nm" $ readLength "1000nm" `shouldBe` Just (nauticalMiles 1000)
+        it "reads 25000ft" $ readLength "25000ft" `shouldBe` Just (feet 25000)
     describe "Reading invalid lengths" $ do
-        it "fails to read 5" $ readLengthE "5" `shouldBe` Left "couldn't read length 5"
-        it "fails to read 5nmi" $ readLengthE "5nmi" `shouldBe` Left "couldn't read length 5nmi"
+        it "fails to read 5" $ readLength "5" `shouldBe` Nothing
+        it "fails to read 5nmi" $ readLength "5nmi" `shouldBe` Nothing
     describe "Showing lengths" $ do
         it "shows length in metres when <= 10000 m" $ show (metres 5) `shouldBe` "5.0m"
         it "shows length in kilometres when > 10000 m" $
+ test/Data/Geo/Jord/LocalFramesSpec.hs view
@@ -0,0 +1,78 @@+module Data.Geo.Jord.LocalFramesSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.LocalFrames
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec = do
+    describe "Ellipsoidal earth model" $ do
+        describe "target" $ do
+            it "return the given position if NED norm = 0" $ do
+                let p0 = wgs84Pos 53.320556 (-1.729722) zero
+                let d = ned zero zero zero
+                targetN p0 d `shouldBe` p0
+            it "computes the target position from p0 and NED" $ do
+                let p0 = wgs84Pos 49.66618 3.45063 zero
+                let d = nedMetres (-86126) (-78900) 1069
+                targetN p0 d `shouldBe` wgs84Pos 48.886668961666665 2.3747212533333335 (metres 0.198937)
+            it "computes the target position from p0 and vector in Frame B" $ do
+                let p0 = wgs84Pos 49.66618 3.45063 zero
+                let y = decimalDegrees 10 -- yaw
+                let r = decimalDegrees 20 -- roll
+                let p = decimalDegrees 30 -- pitch
+                let d = deltaMetres 3000 2000 100
+                target p0 (frameB y r p) d `shouldBe` wgs84Pos 49.69180157805555 3.4812670616666668 (metres 6.007736)
+        describe "nedBetween" $ do
+            it "computes NED between surface positions" $ do
+                let p1 = wgs84Pos 49.66618 3.45063 zero
+                let p2 = wgs84Pos 48.88667 2.37472 zero
+                let d = nedBetween p1 p2
+                d `shouldBe` nedMetres (-86125.880548) (-78900.087817) 1069.19844
+            it "computes NED between positions" $ do
+                let p1 = wgs84Pos 49.66618 3.45063 (metres 12000)
+                let p2 = wgs84Pos 48.88667 2.37472 (metres 15000)
+                let d = nedBetween p1 p2
+                d `shouldBe` nedMetres (-86328.623924) (-79085.290891) (-1928.287848)
+        describe "deltaBetween" $
+            it "computes delta between positions in frame L" $ do
+                let p1 = wgs84Pos 1 2 (metres (-3))
+                let p2 = wgs84Pos 4 5 (metres (-6))
+                let w = decimalDegrees 5 -- wander azimuth
+                let d = deltaBetween p1 p2 (frameL w)
+                d `shouldBe` deltaMetres 359490.578214 302818.522536 17404.271362
+        describe "deltaBetween and target consistency" $
+            it "computes targetN p1 (nedBetween p1 p2) = p2" $ do
+                let p1 = wgs84Pos 49.66618 3.45063 zero
+                let p2 = wgs84Pos 48.88667 2.37472 zero
+                targetN p1 (nedBetween p1 p2) `shouldBe` p2
+        describe "rotation matrix to/from earth-fixed frame" $ do
+            it "computes rEN (frame N to earth-fixed frame)" $ do
+                let p = wgs84Pos 49.66618 3.45063 zero
+                let f = frameN p
+                rEF f `shouldBe`
+                    [ Vector3d (-0.7609044147683025) (-6.018845511258954e-2) (-0.646066421861767)
+                    , Vector3d (-4.5880841733693466e-2) 0.9981870315082038 (-3.895636649699221e-2)
+                    , Vector3d 0.6472398473115779 0.0 (-0.7622864160222752)
+                    ]
+            it "computes rEB (frame B to earth-fixed frame)" $ do
+                let p = wgs84Pos 49.66618 3.45063 zero
+                let f = frameB (decimalDegrees 10) (decimalDegrees 20) (decimalDegrees 30) p
+                rEF f `shouldBe`
+                    [ Vector3d (-0.49300713580470057) (-0.37038991706707025) (-0.7872453705044535)
+                    , Vector3d 0.1337450488624887 0.8618333991596926 (-0.4892396692804258)
+                    , Vector3d 0.8596837941652826 (-0.3464888186188679) (-0.375352198104241)
+                    ]
+    describe "North, East, Down delta" $ do
+        describe "slantRange" $
+            it "computes the slant range of a NED vector" $
+            slantRange (nedMetres (-86126) (-78900) 1069) `shouldBe` metres 116807.707952
+        describe "bearing" $
+            it "computes the bearing of a NED vector" $
+            bearing (nedMetres (-86126) (-78900) 1069) `shouldBe` decimalDegrees 222.49278897666667
+        describe "elevation" $
+            it "computes the elevation of a NED vector from horizontal" $
+            elevation (nedMetres (-86126) (-78900) 1069) `shouldBe` decimalDegrees (-0.5243664513888889)
+ test/Data/Geo/Jord/PositionSpec.hs view
@@ -0,0 +1,71 @@+module Data.Geo.Jord.PositionSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec = do
+    describe "antipode" $ do
+        it "returns the antipodal position" $ do
+            antipode (wgs84Pos 45 154 (metres 15000)) `shouldBe` wgs84Pos (-45) (-26) (metres 15000)
+            antipode (s84Pos 45 154 (metres 15000)) `shouldBe` s84Pos (-45) (-26) (metres 15000)
+        it "returns the south pole when called with the north pole" $ do
+            latitude (antipode (northPole WGS84)) `shouldBe` latitude (southPole WGS84)
+            latitude (antipode (northPole S84)) `shouldBe` latitude (southPole S84)
+        it "returns the north pole when called with the south pole" $ do
+            latitude (antipode (southPole WGS84)) `shouldBe` latitude (northPole WGS84)
+            latitude (antipode (southPole S84)) `shouldBe` latitude (northPole S84)
+    describe "wrapping latitude/longitude" $ do
+        it "wraps a Earth position to [-90°, 90°] and [-180°, 180°]" $
+            latLong (s84Pos 91 54 zero) `shouldBe` (89, -126)
+        it "wraps a Mars position to [-90°, 90°] and [0°, 360°]" $
+            latLong (latLongPos 91 (-150) Mars2000) `shouldBe` (89, 210)
+    describe "Geodetic <=> Geocentric (Ellipsoidal)" $ do
+        it "n-vector <=> Geocentric" $ do
+            let p = nvectorPos 0.5 0.5 0.7071 WGS84
+            let g = geocentricMetresPos 3194434.410968 3194434.410968 4487326.819509 WGS84
+            p `shouldBe` g
+        it "latitude, longitude and height <=> Geocentric" $ do
+            let refLlh =
+                    [ latLongHeightPos 0 0 zero WGS84
+                    , latLongHeightPos 90 0 zero WGS84
+                    , latLongHeightPos (-90) 0 zero WGS84
+                    , latLongHeightPos 45.0 45.0 (metres 500) WGS84
+                    , latLongHeightPos (-45) (-45) (metres 500) WGS84
+                    ]
+            let refGeocentrics =
+                    [ geocentricMetresPos 6378137 0 0 WGS84
+                    , geocentricMetresPos 0 0 6356752.314245 WGS84
+                    , geocentricMetresPos 0 0 (-6356752.314245) WGS84
+                    , geocentricMetresPos 3194669.145061 3194669.145061 4487701.962256 WGS84
+                    , geocentricMetresPos
+                          3194669.145061
+                          (-3194669.145061)
+                          (-4487701.962256)
+                          WGS84
+                    ]
+            refLlh `shouldBe` refGeocentrics
+    describe "Geodetic <=> Geocentric (Spherical)" $ do
+        it "n-vector <=> Geocentric" $ do
+            let p = nvectorPos 0.5 0.5 0.7071 S84
+            let g = geocentricMetresPos 3185519.660311 3185519.660311 4504961.903612 S84
+            p `shouldBe` g
+        it "latitude, longitude and height <=> Geocentric" $ do
+            let refLlh =
+                    [ latLongHeightPos 0 0 zero S84
+                    , latLongHeightPos 90 0 zero S84
+                    , latLongHeightPos (-90) 0 zero S84
+                    , latLongHeightPos 45.0 45.0 (metres 500) S84
+                    , latLongHeightPos (-45) (-45) (metres 500) S84
+                    ]
+            let refGeocentrics =
+                    [ geocentricMetresPos 6371008.771415 0 0 S84
+                    , geocentricMetresPos 0 0 6371008.771415 S84
+                    , geocentricMetresPos 0 0 (-6371008.771415) S84
+                    , geocentricMetresPos 3185754.385708 3185754.385708 4505337.058657 S84
+                    , geocentricMetresPos 3185754.385708 (-3185754.385708) (-4505337.058657) S84
+                    ]
+            refLlh `shouldBe` refGeocentrics
+ test/Data/Geo/Jord/ReadPositionSpec.hs view
@@ -0,0 +1,77 @@+module Data.Geo.Jord.ReadPositionSpec
+    ( spec
+    ) where
+
+import Data.Maybe (mapMaybe)
+
+import Test.Hspec
+
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec = do
+    describe "Reading valid DMS text" $ do
+        it "reads WGS84 surface positions" $ do
+            let texts =
+                    [ "553621N0130002E"
+                    , "5536N01300E"
+                    , "55N013E"
+                    , "011659S0364900E"
+                    , "0116S03649E"
+                    , "01S036E"
+                    , "473622N1221955W"
+                    , "4736N12219W"
+                    , "47N122W"
+                    , "544807S0681811W"
+                    , "5448S06818W"
+                    , "54S068W"
+                    , "55°36'21''N 013°00'02''E"
+                    , "1°16'S,36°49'E"
+                    , "47°N 122°W"
+                    ]
+            let positions =
+                    [ wgs84Pos 55.60583333333334 13.000555555555556 zero
+                    , wgs84Pos 55.6 13.0 zero
+                    , wgs84Pos 55.0 13.0 zero
+                    , wgs84Pos (-1.2830555555555556) 36.81666666666667 zero
+                    , wgs84Pos (-1.2666666666666666) 36.81666666666667 zero
+                    , wgs84Pos (-1.0) 36.0 zero
+                    , wgs84Pos 47.60611111111111 (-122.33194444444445) zero
+                    , wgs84Pos 47.6 (-122.31666666666666) zero
+                    , wgs84Pos 47.0 (-122.0) zero
+                    , wgs84Pos (-54.801944444444445) (-68.30305555555556) zero
+                    , wgs84Pos (-54.8) (-68.3) zero
+                    , wgs84Pos (-54.0) (-68.0) zero
+                    , wgs84Pos 55.60583333333334 13.000555555555556 zero
+                    , wgs84Pos (-1.2666666666666666) 36.81666666666667 zero
+                    , wgs84Pos 47.0 (-122.0) zero
+                    ]
+            mapMaybe (`readPosition` WGS84) texts `shouldBe` positions
+        it "reads positions around the WGS84 ellipsoid" $ do
+            let texts = ["55°36'21''N 013°00'02''E 5m", "55°36'21''N 013°00'02''E -5m"]
+            let positions =
+                    [ wgs84Pos 55.60583333333334 13.000555555555556 (metres 5)
+                    , wgs84Pos 55.60583333333334 13.000555555555556 (metres (-5))
+                    ]
+            mapMaybe (`readPosition` WGS84) texts `shouldBe` positions
+        it "reads positions around the S84 sphere" $ do
+            let texts = ["55°36'21''N 013°00'02''E 5m", "55°36'21''N 013°00'02''E -5m"]
+            let positions =
+                    [ s84Pos 55.60583333333334 13.000555555555556 (metres 5)
+                    , s84Pos 55.60583333333334 13.000555555555556 (metres (-5))
+                    ]
+            mapMaybe (`readPosition` S84) texts `shouldBe` positions
+        it "reads Mars surface positions" $ do
+            let texts = ["54S360E", "55°36'21''N 341°34'02''E"]
+            let positions = [latLongPos (-54.0) 360 Mars2000, latLongPos 55.60583333333334 341.5672222222222 Mars2000]
+            mapMaybe (`readPosition` Mars2000) texts `shouldBe` positions
+    describe "Attempting to read invalid DMS text" $ do
+        it "fails to read syntactically invalid positions" $ do
+            let texts = ["553621K0130002E", "011659S0364900Z", "4736221221955W", "54480S0681811W"]
+            mapMaybe (`readPosition` WGS84) texts `shouldBe` []
+        it "fails to read invalid WGS84 surface positions" $ do
+            let texts = ["914807S0681811W", "804807S1811811W"]
+            mapMaybe (`readPosition` WGS84) texts `shouldBe` []
+        it "fails to read invalid Mars surface positions" $ do
+            let texts = ["914807S0681811E", "5448S06818W"]
+            mapMaybe (`readPosition` Mars2000) texts `shouldBe` []
test/Data/Geo/Jord/RotationSpec.hs view
@@ -2,8 +2,11 @@     ( spec
     ) where
 
-import Data.Geo.Jord
 import Test.Hspec
+
+import Data.Geo.Jord.Angle
+import Data.Geo.Jord.Rotation
+import Data.Geo.Jord.Vector3d
 
 spec :: Spec
 spec = do
+ test/Data/Geo/Jord/ShowPositionSpec.hs view
@@ -0,0 +1,23 @@+module Data.Geo.Jord.ShowPositionSpec
+    ( spec
+    ) where
+
+import Test.Hspec
+
+import Data.Geo.Jord.Position
+
+spec :: Spec
+spec =
+    describe "Showing positions" $ do
+        it "shows the N/E position formatted in DMS with symbols" $
+            show (wgs84Pos 55.6058333333 13.00055556 (metres 5)) `shouldBe`
+            "55°36'21.000\"N,13°0'2.000\"E 5.0m (WGS84)"
+        it "shows the S/E position formatted in DMS with symbols" $
+            show (latLongPos (-1.28305556) 36.81666 GRS80) `shouldBe`
+            "1°16'59.000\"S,36°48'59.976\"E 0.0m (GRS80)"
+        it "shows the N/W position formatted in DMS with symbols" $
+            show (latLongPos 47.60611 (-122.33194) S84) `shouldBe`
+            "47°36'21.996\"N,122°19'54.984\"W 0.0m (S84)"
+        it "shows the S/W position formatted in DMS with symbols" $
+            show (latLongPos (-54.80194) (-68.30305) S84) `shouldBe`
+            "54°48'6.984\"S,68°18'10.980\"W 0.0m (S84)"
test/Data/Geo/Jord/SpeedSpec.hs view
@@ -2,20 +2,22 @@     ( spec
     ) where
 
-import Data.Geo.Jord
 import Test.Hspec
 
+import Data.Geo.Jord.Quantity
+import Data.Geo.Jord.Speed
+
 spec :: Spec
 spec = do
     describe "Reading valid speeds" $ do
-        it "reads -15.2m/s" $ readSpeed "-15.2m/s" `shouldBe` metresPerSecond (-15.2)
-        it "reads 154km/h" $ readSpeed "154km/h" `shouldBe` kilometresPerHour 154
-        it "reads 200mph" $ readSpeed "200mph" `shouldBe` milesPerHour 200
-        it "reads 400kt" $ readSpeed "400kt" `shouldBe` knots 400
-        it "reads 1ft/s" $ readSpeed "1ft/s" `shouldBe` feetPerSecond 1
+        it "reads -15.2m/s" $ readSpeed "-15.2m/s" `shouldBe` Just (metresPerSecond (-15.2))
+        it "reads 154km/h" $ readSpeed "154km/h" `shouldBe` Just (kilometresPerHour 154)
+        it "reads 200mph" $ readSpeed "200mph" `shouldBe` Just (milesPerHour 200)
+        it "reads 400kt" $ readSpeed "400kt" `shouldBe` Just (knots 400)
+        it "reads 1ft/s" $ readSpeed "1ft/s" `shouldBe` Just (feetPerSecond 1)
     describe "Reading invalid speeds" $ do
-        it "fails to read 5" $ readSpeedE "5" `shouldBe` Left "couldn't read speed 5"
-        it "fails to read 5mps" $ readSpeedE "5mps" `shouldBe` Left "couldn't read speed 5mps"
+        it "fails to read 5" $ readSpeed "5" `shouldBe` Nothing
+        it "fails to read 5mps" $ readSpeed "5mps" `shouldBe` Nothing
     describe "Showing speeds" $
         it "shows speed in kilometres per hour" $
         show (kilometresPerHour 154) `shouldBe` "154.0km/h"
@@ -37,5 +39,5 @@     describe "Adding/Subtracting speeds" $ do
         it "adds speeds" $
             add (kilometresPerHour 1000) (metresPerSecond 1000) `shouldBe` kilometresPerHour 4600
-        it "subtracts lengths" $
+        it "subtracts speeds" $
             sub (metresPerSecond 1000) (knots 10.5) `shouldBe` kilometresPerHour 3580.554
test/Data/Geo/Jord/TransformationSpec.hs view
@@ -2,68 +2,51 @@     ( spec
     ) where
 
-import Data.Geo.Jord
 import Test.Hspec
 
+import Data.Geo.Jord.Position
+import Data.Geo.Jord.Transformation
+
 spec :: Spec
 spec = do
-    describe "Ellipsoidal transformation between coordinates systems" $ do
-        it "transforms NVector position to ECEF position" $ do
-            let p = nvector 0.5 0.5 0.7071
-            toEcef p wgs84 `shouldBe` ecefMetres 3194434.411 3194434.411 4487326.8195
-        it "transforms angular position to ECEF position" $ do
-            let refAngular =
-                    [ decimalLatLongHeight 39.379 (-48.013) (metres 4702059.834)
-                    , decimalLatLongHeight 45.0 45.0 zero
-                    , decimalLatLongHeight 48.8562 2.3508 (metres 67.36972232195099)
-                    ]
-            let refEcefs =
-                    [ ecefMetres 5733855.7748 (-6370998.3802) 7008137.5108
-                    , ecefMetres 3194419.1451 3194419.1451 4487348.4088
-                    , ecefMetres 4200996.7697 172460.3207 4780102.808
-                    ]
-            mapM_ (\(a, e) -> toEcef a wgs84 `shouldBe` e) (zip refAngular refEcefs)
-        it "transforms ECEF position to angular position" $ do
-            let refAngular =
-                    [ decimalLatLongHeight 39.379 (-48.013) (metres 4702059.8339)
-                    , decimalLatLongHeight 45.0 45.0 (metres (-0.0001))
-                    , decimalLatLongHeight 48.8562 2.3508 (metres 67.3697)
-                    ]
-            let refEcefs =
-                    [ ecefMetres 5733855.774881717 (-6370998.380260889) 7008137.510624695
-                    , ecefMetres 3194419.145121972 3194419.145121971 4487348.408606014
-                    , ecefMetres 4200996.769831858 172460.320727757 4780102.807914356
-                    ]
-            mapM_ (\(a, e) -> fromEcef e wgs84 `shouldBe` a) (zip refAngular refEcefs)
-    describe "Spherical transformation between coordinates systems" $ do
-        it "transforms NVector position to ECEF position" $ do
-            let p = nvector 0.5 0.5 0.7071
-            toEcef p s84 `shouldBe` ecefMetres 3185519.6603 3185519.6603 4504961.9036
-        it "transforms angular position to ECEF position" $ do
-            let refAngular =
-                    [ decimalLatLongHeight 39.379 (-48.013) (metres 4702059.834)
-                    , decimalLatLongHeight 45.0 45.0 zero
-                    , decimalLatLongHeight 48.8562 2.3508 (metres 67.36972232195099)
-                    , latLongHeight (readLatLong "531914N0014347W") (metres 15000.0)
-                    , decimalLatLongHeight 53.1882691 0.1332744 (metres 15000.0)
-                    ]
-            let refEcefs =
-                    [ ecefMetres 5725717.3542 (-6361955.6232) 7025277.9139
-                    , ecefMetres 3185504.3857 3185504.3857 4504983.5053
-                    , ecefMetres 4188328.8913 171940.276 4797806.6692
-                    , ecefMetres 3812864.0945 (-115142.8631) 5121515.1612
-                    , ecefMetres 3826406.4644 8900.5354 5112694.2386
-                    ]
-            mapM_ (\(a, e) -> toEcef a s84 `shouldBe` e) (zip refAngular refEcefs)
-        it "transforms ECEF position to angular position" $ do
-            let refAngular =
-                    [ decimalLatLongHeight 39.379 (-48.013) (metres 4702059.8338)
-                    , decimalLatLongHeight 45.0 45.0 (metres 1e-4)
-                    , decimalLatLongHeight 48.8562 2.3508 (metres 67.3693)
-                    ]
-            let refEcefs =
-                    [ ecefMetres 5725717.354 (-6361955.623) 7025277.914
-                    , ecefMetres 3185504.386 3185504.386 4504983.505
-                    , ecefMetres 4188328.891 171940.276 4797806.669
-                    ]
-            mapM_ (\(a, e) -> fromEcef e s84 `shouldBe` a) (zip refAngular refEcefs)
+    describe "coordinates static transformation" $ do
+        it "returns the initial coordinates if all parameters are 0" $ do
+            let tx7 = txParams7 (0, 0, 0) 0 (0, 0, 0)
+            let pWGS84 = wgs84Pos 48.6921 6.1844 (metres 188)
+            transformCoords' pWGS84 WGS84 tx7 `shouldBe` pWGS84
+        it "uses the 7-parameter transformation" $ do
+            let pWGS84 = wgs84Pos 48.6921 6.1844 (metres 188)
+            let tx = txParams from_WGS84_to_NAD83
+            let pNAD83 = transformCoords' pWGS84 NAD83 tx
+            pNAD83 `shouldBe`
+                latLongHeightPos
+                    48.69208978369768
+                    6.184367561060834
+                    (metres 188.12122946884483)
+                    NAD83
+        it "returns the initial coordinates when doing round-trip (direct -> inverse)" $ do
+            let tx = txParams from_WGS84_to_NAD83
+            let itx = inverseTxParams tx
+            let pWGS84 = wgs84Pos 48.6921 6.1844 (metres 188)
+            transformCoords' (transformCoords' pWGS84 NAD83 tx) WGS84 itx `shouldBe` pWGS84
+    describe "coordinates dynamic transformation" $ do
+        it "returns the initial coordinates if all parameters are 0" $ do
+            let tx15 =
+                    TxParams15
+                        (Epoch 2010)
+                        (txParams7 (0, 0, 0) 0 (0, 0, 0))
+                        (txRates (0, 0, 0) 0 (0, 0, 0))
+            let pWGS84 = latLongHeightPos 48.6921 6.1844 (metres 188) WGS84_G1762
+            transformCoordsAt' pWGS84 (Epoch 2010.0) WGS84_G1762 tx15 `shouldBe` pWGS84
+        it "uses the 15-parameter transformation and position epoch" $ do
+            let pITRF2014 = geocentricMetresPos 4027894.006 307045.600 4919474.910 ITRF2014
+            let tx = txParams from_ITRF2014_to_ETRF2000
+            let pETRF2000 = transformCoordsAt' pITRF2014 (Epoch 2012.0) ETRF2000 tx
+            pETRF2000 `shouldBe` geocentricMetresPos 4027894.366234 307045.252967 4919474.626307 ETRF2000
+        it "returns the initial coordinates when doing round-trip (direct -> inverse)" $ do
+            let tx = txParams from_ITRF2014_to_ETRF2000
+            let itx = inverseTxParams tx
+            let pITRF2014 = geocentricMetresPos 4027894.006 307045.600 4919474.910 ITRF2014
+            let e = Epoch 2019.0
+            transformCoordsAt' (transformCoordsAt' pITRF2014 e ETRF2000 tx) e ITRF2014 itx `shouldBe`
+                pITRF2014
test/Spec.hs view