packages feed

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 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)    ]