geodetics 0.0.4 → 0.0.5
raw patch · 6 files changed
+54/−18 lines, 6 filesdep +checkersdep +geodeticsdep ~basedep ~dimensionalPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: checkers, geodetics
Dependency ranges changed: base, dimensional
API changes (from Hackage documentation)
+ Geodetics.Ellipsoids: instance Data.Semigroup.Semigroup Geodetics.Ellipsoids.Helmert
+ Geodetics.Grid: instance Data.Semigroup.Semigroup Geodetics.Grid.GridOffset
- Geodetics.Altitude: class HasAltitude a where groundPosition = setAltitude _0
+ Geodetics.Altitude: class HasAltitude a
- Geodetics.Ellipsoids: class (Show a, Eq a) => Ellipsoid a where helmertToWSG84 e = applyHelmert (helmert e) helmertFromWSG84 e = applyHelmert (inverseHelmert $ helmert e)
+ Geodetics.Ellipsoids: class (Show a, Eq a) => Ellipsoid a
Files
- geodetics.cabal +14/−4
- src/Geodetics/Ellipsoids.hs +9/−6
- src/Geodetics/Geodetic.hs +1/−1
- src/Geodetics/Grid.hs +9/−5
- src/Geodetics/TransverseMercator.hs +1/−1
- test/Main.hs +20/−1
geodetics.cabal view
@@ -1,5 +1,5 @@ name: geodetics-version: 0.0.4+version: 0.0.5 cabal-version: >= 1.10 build-type: Simple author: Paul Johnson <paul@cogito.org.uk>@@ -50,7 +50,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs x-uses-tf: true- build-depends:+ build-depends: geodetics, base >= 4.6 && < 5, HUnit >= 1.2, dimensional >= 0.13,@@ -58,12 +58,22 @@ test-framework >= 0.4.1, test-framework-quickcheck2, test-framework-hunit,- array >= 0.4+ array >= 0.4,+ checkers hs-source-dirs: src, test ghc-options: -Wall -rtsopts other-modules: ArbitraryInstances,- Main+ Main,+ Geodetics.Altitude,+ Geodetics.Ellipsoids+ Geodetics.Geodetic,+ Geodetics.Grid,+ Geodetics.LatLongParser,+ Geodetics.Path,+ Geodetics.Stereographic,+ Geodetics.TransverseMercator,+ Geodetics.UK Default-Language: Haskell2010
src/Geodetics/Ellipsoids.hs view
@@ -39,7 +39,8 @@ cross3 ) where -import Data.Monoid+import Data.Monoid (Monoid)+import Data.Semigroup (Semigroup, (<>)) import Numeric.Units.Dimensional import Numeric.Units.Dimensional.Prelude import Prelude () -- Numeric instances.@@ -110,12 +111,14 @@ helmertScale :: Dimensionless Double, -- ^ Parts per million rX, rY, rZ :: Dimensionless Double } deriving (Eq, Show) -instance Monoid Helmert where- mempty = Helmert (0 *~ meter) (0 *~ meter) (0 *~ meter) _1 _0 _0 _0- mappend h1 h2 = Helmert (cX h1 + cX h2) (cY h1 + cY h2) (cZ h1 + cZ h2)- (helmertScale h1 + helmertScale h2)- (rX h1 + rX h2) (rY h1 + rY h2) (rZ h1 + rZ h2)+instance Semigroup Helmert where+ h1 <> h2 = Helmert (cX h1 + cX h2) (cY h1 + cY h2) (cZ h1 + cZ h2)+ (helmertScale h1 + helmertScale h2)+ (rX h1 + rX h2) (rY h1 + rY h2) (rZ h1 + rZ h2) +instance Monoid Helmert where+ mempty = Helmert (0 *~ meter) (0 *~ meter) (0 *~ meter) _0 _0 _0 _0+ mappend = (<>) -- | The inverse of a Helmert transformation. inverseHelmert :: Helmert -> Helmert
src/Geodetics/Geodetic.hs view
@@ -26,7 +26,7 @@ import Geodetics.Altitude import Geodetics.Ellipsoids import Geodetics.LatLongParser-import Numeric.Units.Dimensional.Prelude+import Numeric.Units.Dimensional.Prelude hiding ((.)) import Text.ParserCombinators.ReadP import qualified Prelude as P
src/Geodetics/Grid.hs view
@@ -23,10 +23,11 @@ import Data.Char import Data.Function-import Data.Monoid+import Data.Monoid (Monoid)+import Data.Semigroup (Semigroup, (<>)) import Geodetics.Altitude import Geodetics.Geodetic-import Numeric.Units.Dimensional.Prelude+import Numeric.Units.Dimensional.Prelude hiding ((.)) import qualified Prelude as P -- | A Grid is a two-dimensional projection of the ellipsoid onto a plane. Any given type of grid can@@ -69,11 +70,14 @@ deltaEast, deltaNorth, deltaAltitude :: Length Double } deriving (Eq, Show) +instance Semigroup GridOffset where+ g1 <> g2 = GridOffset (deltaEast g1 + deltaEast g2)+ (deltaNorth g1 + deltaNorth g2)+ (deltaAltitude g1 + deltaAltitude g2)+ instance Monoid GridOffset where mempty = GridOffset _0 _0 _0- mappend g1 g2 = GridOffset (deltaEast g1 + deltaEast g2) - (deltaNorth g1 + deltaNorth g2) - (deltaAltitude g1 + deltaAltitude g2) + mappend = (<>) -- | An offset defined by a distance and a bearing to the right of North. --
src/Geodetics/TransverseMercator.hs view
@@ -10,7 +10,7 @@ import Geodetics.Ellipsoids import Geodetics.Geodetic import Geodetics.Grid-import Numeric.Units.Dimensional.Prelude+import Numeric.Units.Dimensional.Prelude hiding ((.)) import Prelude () -- | A Transverse Mercator projection gives an approximate mapping of the ellipsoid on to a 2-D grid. It models
test/Main.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module Main where @@ -12,6 +13,8 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import qualified Test.HUnit as HU import Test.QuickCheck+import Test.QuickCheck.Checkers (EqProp, eq, (=-=), unbatch)+import Test.QuickCheck.Classes (monoid) import ArbitraryInstances import Geodetics.Altitude@@ -38,6 +41,20 @@ defaultMainWithOpts tests my_runner_opts +instance EqProp GridOffset where+ (GridOffset a b c) =-= (GridOffset a' b' c') =+ eq True $ a ≈ a' && b ≈ b' && c ≈ c'+ where x ≈ y = abs (x - y) < 0.00001 *~ meter++instance EqProp Helmert where+ (Helmert cX' cY' cZ' s rX' rY' rZ') =-= (Helmert cX'' cY'' cZ'' s' rX'' rY'' rZ'') =+ eq True $ and [cX' ≈ cX'', cY' ≈ cY'', cZ' ≈ cZ'',+ s ≈- s',+ rX' ≈- rX'', rY' ≈- rY'', rZ' ≈- rZ'']++ where x ≈ y = abs (x - y) < 0.00001 *~ meter+ x ≈- y = abs (x - y) < (_1 / (_5 * _2) ** (_5))+ tests :: [Test] tests = [ testGroup "Geodetic" [@@ -69,7 +86,9 @@ testProperty "Ray Bisection" prop_rayBisect, testProperty "Rhumb Continuity" prop_rhumbContinuity, testProperty "Rhumb Intersection" prop_rhumbIntersect- ]+ ],+ testGroup "GridOffset" $ map (uncurry testProperty) $ unbatch $ monoid (mempty :: GridOffset),+ testGroup "Helmert" $ map (uncurry testProperty) $ unbatch $ monoid (mempty :: Helmert) ]