coordinate 0.0.21 → 0.1.0
raw patch · 20 files changed
+582/−1172 lines, 20 filesdep −radiandep −taggeddep ~basedep ~lensdep ~transformers
Dependencies removed: radian, tagged
Dependency ranges changed: base, lens, transformers
Files
- changelog +0/−55
- changelog.md +59/−0
- coordinate.cabal +14/−16
- other-licence.md +14/−0
- src/Data/Geo/Coordinate.hs +0/−9
- src/Data/Geo/Coordinate/Coordinate.hs +0/−224
- src/Data/Geo/Coordinate/DegreesLatitude.hs +0/−126
- src/Data/Geo/Coordinate/DegreesLongitude.hs +0/−126
- src/Data/Geo/Coordinate/Latitude.hs +0/−213
- src/Data/Geo/Coordinate/Longitude.hs +0/−213
- src/Data/Geo/Coordinate/Minutes.hs +0/−87
- src/Data/Geo/Coordinate/Seconds.hs +0/−103
- src/Data/Geodetic.hs +13/−0
- src/Data/Geodetic/ECEF.hs +39/−0
- src/Data/Geodetic/Ellipsoid.hs +47/−0
- src/Data/Geodetic/EllipsoidReaderT.hs +279/−0
- src/Data/Geodetic/HasDoubles.hs +16/−0
- src/Data/Geodetic/LL.hs +33/−0
- src/Data/Geodetic/LLH.hs +39/−0
- src/Data/Geodetic/XY.hs +29/−0
− changelog
@@ -1,55 +0,0 @@-0.0.21--* fix modulo arithmetic for minutes, seconds.-* antipode functions.--0.0.20--* fix modulo arithmetic for latitude and longitude.--0.0.19--* Add lenses from latitude, longitude minutes, seconds.-* Add traversals from coordinate to minutes, seconds.-* Generalise coordinate operators.--0.0.18--* Update dependency on `radian`.--0.0.17--* Include prisms for radians. Requires a dependency on the `radian` package.--0.0.16--* Some minor fixes to the documentation.--0.0.15--* Change mod functions to use rem.--0.0.14--* Add mod functions for `DegreesLatitude` and `DegreesLongitude`.--0.0.13--* Tidy up imports-:-* Tidy up code duplication--0.0.12--* Remove extraneous frac Prism--0.0.11--* Use Optic to overload lenses, prisms and isos.--* Remove use of radians (for now).--0.0.10--This change log started.-
+ changelog.md view
@@ -0,0 +1,59 @@+0.1.0++* A rewrite using `ECEF`, `XY, `LLH`, `LL` data types.++0.0.21++* fix modulo arithmetic for minutes, seconds.+* antipode functions.++0.0.20++* fix modulo arithmetic for latitude and longitude.++0.0.19++* Add lenses from latitude, longitude minutes, seconds.+* Add traversals from coordinate to minutes, seconds.+* Generalise coordinate operators.++0.0.18++* Update dependency on `radian`.++0.0.17++* Include prisms for radians. Requires a dependency on the `radian` package.++0.0.16++* Some minor fixes to the documentation.++0.0.15++* Change mod functions to use rem.++0.0.14++* Add mod functions for `DegreesLatitude` and `DegreesLongitude`.++0.0.13++* Tidy up imports+:+* Tidy up code duplication++0.0.12++* Remove extraneous frac Prism++0.0.11++* Use Optic to overload lenses, prisms and isos.++* Remove use of radians (for now).++0.0.10++This change log started.+
coordinate.cabal view
@@ -1,5 +1,5 @@ name: coordinate-version: 0.0.21+version: 0.1.0 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>@@ -15,7 +15,7 @@ bug-reports: https://github.com/NICTA/coordinate/issues cabal-version: >= 1.10 build-type: Custom-extra-source-files: changelog+extra-source-files: changelog.md, other-licence.md source-repository head type: git@@ -29,12 +29,10 @@ Haskell2010 build-depends:- base < 5 && >= 3- , lens >= 4.0- , tagged >= 0.7- , transformers >= 0.3.0.0- , radian >= 0.0.4-+ base >= 4 && < 5+ , lens >= 4.0 && < 5.0+ , transformers >= 0.4 && < 0.6+ ghc-options: -Wall @@ -45,14 +43,14 @@ src exposed-modules:- Data.Geo.Coordinate- Data.Geo.Coordinate.Coordinate- Data.Geo.Coordinate.DegreesLatitude- Data.Geo.Coordinate.DegreesLongitude- Data.Geo.Coordinate.Latitude- Data.Geo.Coordinate.Longitude- Data.Geo.Coordinate.Minutes- Data.Geo.Coordinate.Seconds+ Data.Geodetic+ Data.Geodetic.ECEF+ Data.Geodetic.Ellipsoid+ Data.Geodetic.EllipsoidReaderT+ Data.Geodetic.HasDoubles+ Data.Geodetic.LLH+ Data.Geodetic.LL+ Data.Geodetic.XY test-suite doctests type:
+ other-licence.md view
@@ -0,0 +1,14 @@+# geodetics++> Copyright (c) 2014, Paul Johnson <paul@cogito.org.uk>+> All rights reserved.+> +> Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+> +> 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+> +> 2. 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.+> +> 3. Neither the name of Paul Johnson <paul@cogito.org.uk> nor the names of its 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 HOLDER 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.
− src/Data/Geo/Coordinate.hs
@@ -1,9 +0,0 @@-module Data.Geo.Coordinate(module C) where--import Data.Geo.Coordinate.Coordinate as C-import Data.Geo.Coordinate.DegreesLatitude as C-import Data.Geo.Coordinate.DegreesLongitude as C-import Data.Geo.Coordinate.Latitude as C-import Data.Geo.Coordinate.Longitude as C-import Data.Geo.Coordinate.Minutes as C-import Data.Geo.Coordinate.Seconds as C
− src/Data/Geo/Coordinate/Coordinate.hs
@@ -1,224 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}--module Data.Geo.Coordinate.Coordinate(- Coordinate-, AsCoordinate(..)-, latitudeMinutes-, latitudeSeconds-, longitudeMinutes-, longitudeSeconds-, (.#.)-, (<°>)-, antipode-) where--import Control.Applicative(Applicative((<*>)))-import Control.Category(Category(id, (.)))-import Control.Lens(Identity, Const, Prism', Choice, Iso', swapped, Profunctor, Optic', (^.), iso, from, lens, prism', swapped, (^?), (#))-import Control.Monad(Monad(return))-import Data.Eq(Eq)-import Data.Functor(Functor, (<$>))-import Data.Geo.Coordinate.Latitude(AsLatitude(_Latitude), Latitude, antipodeLatitude)-import Data.Geo.Coordinate.Longitude(AsLongitude(_Longitude), Longitude, antipodeLongitude)-import Data.Geo.Coordinate.DegreesLatitude(AsDegreesLatitude(_DegreesLatitude), DegreesLatitude)-import Data.Geo.Coordinate.DegreesLongitude(AsDegreesLongitude(_DegreesLongitude), DegreesLongitude)-import Data.Geo.Coordinate.Minutes(Minutes, AsMinutes(_Minutes))-import Data.Geo.Coordinate.Seconds(Seconds, AsSeconds(_Seconds))-import Data.Maybe(Maybe)-import Data.Monoid(First)-import Data.Ord(Ord)-import Data.Tagged(Tagged)-import Data.Tuple(curry, uncurry)-import Prelude(Show, Double)--data Coordinate =- Coordinate- Latitude- Longitude- deriving (Eq, Ord, Show)---- | Build a coordinate from a latitude and longitude.-(.#.) ::- ( - AsLatitude (->) (Const Latitude) lat- , AsLongitude (->) (Const Longitude) lon- ) =>- lat- -> lon- -> Coordinate-lat .#. lon =- Coordinate- (lat ^. _Latitude)- (lon ^. _Longitude)---- | Build a coordinate from a fractional latitude and fractional longitude. Fails--- if either are out of range.-(<°>) ::- Double- -> Double- -> Maybe Coordinate-(<°>) =- curry (^? _Coordinate)--class AsCoordinate p f s where- _Coordinate ::- Optic' p f s Coordinate--instance AsCoordinate p f Coordinate where- _Coordinate =- id--instance (Profunctor p, Functor f) => AsCoordinate p f (Latitude, Longitude) where- _Coordinate =- iso (uncurry Coordinate) (\(Coordinate lat lon) -> (lat, lon))--instance (Profunctor p, Functor f) => AsCoordinate p f (Longitude, Latitude) where- _Coordinate =- swapped . _Coordinate--instance (Profunctor p, Functor f) => AsCoordinate p f ((DegreesLatitude, Minutes, Seconds), Longitude) where- _Coordinate =- iso- (\(lat, lon) -> Coordinate (lat ^. _Latitude) lon)- (\(Coordinate lat lon) -> (_Latitude # lat, lon))--instance (Profunctor p, Functor f) => AsCoordinate p f (Longitude, (DegreesLatitude, Minutes, Seconds)) where- _Coordinate =- swapped . _Coordinate--instance (Profunctor p, Functor f) => AsCoordinate p f (Latitude, (DegreesLongitude, Minutes, Seconds)) where- _Coordinate =- iso- (\(lat, lon) -> Coordinate lat (lon ^. _Longitude))- (\(Coordinate lat lon) -> (lat, _Longitude # lon))--instance (Profunctor p, Functor f) => AsCoordinate p f ((DegreesLongitude, Minutes, Seconds), Latitude) where- _Coordinate =- swapped . _Coordinate--instance (Profunctor p, Functor f) => AsCoordinate p f ((DegreesLatitude, Minutes, Seconds), (DegreesLongitude, Minutes, Seconds)) where- _Coordinate =- iso- (\(lat, lon) -> Coordinate (lat ^. _Latitude) (lon ^. _Longitude))- (\(Coordinate lat lon) -> (_Latitude # lat, _Longitude # lon))--instance (Profunctor p, Functor f) => AsCoordinate p f ((DegreesLongitude, Minutes, Seconds), (DegreesLatitude, Minutes, Seconds)) where- _Coordinate =- swapped . _Coordinate--coordinatePrism' ::- (- AsLatitude Tagged Identity lat- , AsLatitude (->) (Const (First Latitude)) lat- , AsLongitude Tagged Identity lon- , AsLongitude (->) (Const (First Longitude)) lon) =>- Prism' (lat, lon) Coordinate-coordinatePrism' =- coordinatePrism (_Latitude #) (_Longitude #) (^? _Latitude) (^? _Longitude)--coordinatePrism ::- (Latitude -> lat)- -> (Longitude -> lon)- -> (lat -> Maybe Latitude)- -> (lon -> Maybe Longitude)- -> Prism' (lat, lon) Coordinate-coordinatePrism f g h i =- prism'- (\(Coordinate lat lon) -> (f lat, g lon))- (\(lat, lon) ->- do lat' <- h lat- lon' <- i lon- return (Coordinate lat' lon'))--instance (Choice p, Applicative f) => AsCoordinate p f (Double, Double) where- _Coordinate =- coordinatePrism'--instance (Choice p, Applicative f) => AsCoordinate p f (Latitude, Double) where- _Coordinate =- coordinatePrism id (_Longitude #) return (^? _Longitude)- -instance (Choice p, Applicative f) => AsCoordinate p f (Double, Longitude) where- _Coordinate =- coordinatePrism (_Latitude #) id (^? _Latitude) return--instance (Choice p, Applicative f) => AsCoordinate p f ((DegreesLatitude, Minutes, Seconds), Double) where- _Coordinate =- coordinatePrism'--instance (Choice p, Applicative f) => AsCoordinate p f (Double, (DegreesLongitude, Minutes, Seconds)) where- _Coordinate =- coordinatePrism'--instance (p ~ (->), Functor f) => AsLatitude p f Coordinate where- _Latitude =- lens (\(Coordinate lat _) -> lat) (\(Coordinate _ lon) lat -> Coordinate lat lon)- -instance (p ~ (->), Functor f) => AsDegreesLatitude p f Coordinate where- _DegreesLatitude =- _Latitude . _DegreesLatitude--instance (p ~ (->), Functor f) => AsLongitude p f Coordinate where- _Longitude =- lens (\(Coordinate _ lon) -> lon) (\(Coordinate lat _) lon -> Coordinate lat lon)- -instance (p ~ (->), Functor f) => AsDegreesLongitude p f Coordinate where- _DegreesLongitude =- _Longitude . _DegreesLongitude--instance (p ~ (->), Applicative f) => AsMinutes p f Coordinate where- _Minutes f (Coordinate lat lon) =- (\m1 m2 ->- Coordinate- (from _Latitude # (lat ^. _DegreesLatitude, m1, lat ^. _Seconds))- (from _Longitude # (lon ^. _DegreesLongitude, m2, lon ^. _Seconds))) <$> - f (lat ^. _Minutes) <*> - f (lon ^. _Minutes)- -instance (p ~ (->), Applicative f) => AsSeconds p f Coordinate where- _Seconds f (Coordinate lat lon) =- (\s1 s2 ->- Coordinate- (from _Latitude # (lat ^. _DegreesLatitude, lat ^. _Minutes, s1))- (from _Longitude # (lon ^. _DegreesLongitude, lon ^. _Minutes, s2))) <$> - f (lat ^. _Seconds) <*> - f (lon ^. _Seconds)--latitudeMinutes :: - (AsCoordinate (->) f coord, Functor f) =>- Optic' (->) f coord Minutes -latitudeMinutes =- _Coordinate . _Latitude . _Minutes--latitudeSeconds ::- (AsCoordinate (->) f coord, Functor f) =>- Optic' (->) f coord Seconds-latitudeSeconds =- _Coordinate . _Latitude . _Seconds--longitudeMinutes ::- (AsCoordinate (->) f coord, Functor f) =>- Optic' (->) f coord Minutes -longitudeMinutes =- _Coordinate . _Longitude . _Minutes--longitudeSeconds ::- (AsCoordinate (->) f coord, Functor f) =>- Optic' (->) f coord Seconds-longitudeSeconds =- _Coordinate . _Longitude . _Seconds--antipode ::- Iso'- Coordinate- Coordinate-antipode =- let n (Coordinate lat lon) = Coordinate (antipodeLatitude # lat) (antipodeLongitude # lon)- in iso- n- n
− src/Data/Geo/Coordinate/DegreesLatitude.hs
@@ -1,126 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Geo.Coordinate.DegreesLatitude(- DegreesLatitude-, AsDegreesLatitude(..)-, modDegreesLatitude-, antipodeDegreesLatitude-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(Optic', Choice, prism', Iso', iso)-import Data.Bool((&&))-import Data.Eq(Eq((==)))-import Data.Int(Int)-import Data.Maybe(Maybe(Just, Nothing))-import Data.Ord(Ord((<), (>)))-import Prelude(Show, mod, Num(negate, (+), (-)))---- $setup--- >>> import Control.Lens((#), (^?))--- >>> import Data.Foldable(all)--- >>> import Prelude(Eq(..))--newtype DegreesLatitude =- DegreesLatitude Int- deriving (Eq, Ord, Show)--class AsDegreesLatitude p f s where- _DegreesLatitude ::- Optic' p f s DegreesLatitude--instance AsDegreesLatitude p f DegreesLatitude where- _DegreesLatitude =- id---- | A prism on degrees latitude to an integer between -90 and 90 exclusive.------ >>> (7 :: Int) ^? _DegreesLatitude--- Just (DegreesLatitude 7)------ >>> (0 :: Int) ^? _DegreesLatitude--- Just (DegreesLatitude 0)------ >>> (89 :: Int) ^? _DegreesLatitude--- Just (DegreesLatitude 89)------ >>> (90 :: Int) ^? _DegreesLatitude--- Nothing------ >>> (-89 :: Int) ^? _DegreesLatitude--- Just (DegreesLatitude (-89))------ >>> (-90 :: Int) ^? _DegreesLatitude--- Nothing------ prop> all (\m -> _DegreesLatitude # m == (n :: Int)) (n ^? _DegreesLatitude)-instance (Choice p, Applicative f) => AsDegreesLatitude p f Int where- _DegreesLatitude =- prism'- (\(DegreesLatitude i) -> i)- (\i -> if i > -90 && i < 90- then Just (DegreesLatitude i)- else Nothing)---- | Setting a value within the range @-90@ and @90@ using modulo arithmetic.------ >>> modDegreesLatitude 7--- DegreesLatitude 7------ >>> modDegreesLatitude 0--- DegreesLatitude 0------ >>> modDegreesLatitude 90--- DegreesLatitude 90------ >>> modDegreesLatitude (-90)--- DegreesLatitude (-90)------ >>> modDegreesLatitude 1--- DegreesLatitude 1------ >>> modDegreesLatitude 89--- DegreesLatitude 89 ------ >>> modDegreesLatitude 91--- DegreesLatitude (-89)------ >>> modDegreesLatitude (-91)--- DegreesLatitude 89------ >>> modDegreesLatitude 300--- DegreesLatitude (-60)------ >>> modDegreesLatitude (-300)--- DegreesLatitude 60-modDegreesLatitude ::- Int- -> DegreesLatitude-modDegreesLatitude x =- DegreesLatitude (if x == 90 then 90 else mod (x + 90) 180 - 90)---- | The degrees latitude that is symmetrical around the equator.------ >>> antipodeDegreesLatitude # modDegreesLatitude 30--- DegreesLatitude (-30)------ >>> antipodeDegreesLatitude # modDegreesLatitude 80--- DegreesLatitude (-80)------ >>> antipodeDegreesLatitude # modDegreesLatitude 110--- DegreesLatitude 70------ >>> antipodeDegreesLatitude # modDegreesLatitude 0--- DegreesLatitude 0-antipodeDegreesLatitude ::- Iso'- DegreesLatitude- DegreesLatitude-antipodeDegreesLatitude =- let n (DegreesLatitude x) = DegreesLatitude (negate x)- in iso- n- n
− src/Data/Geo/Coordinate/DegreesLongitude.hs
@@ -1,126 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Geo.Coordinate.DegreesLongitude(- DegreesLongitude-, AsDegreesLongitude(..)-, modDegreesLongitude-, antipodeDegreesLongitude-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(Optic', Choice, prism', Iso', iso)-import Data.Bool((&&))-import Data.Eq(Eq((==)))-import Data.Int(Int)-import Data.Maybe(Maybe(Just, Nothing))-import Data.Ord(Ord((<), (>)))-import Prelude(Show, mod, Num(negate, (+), (-)))---- $setup--- >>> import Control.Lens((#), (^?))--- >>> import Data.Foldable(all)--- >>> import Prelude(Eq(..))--newtype DegreesLongitude =- DegreesLongitude Int- deriving (Eq, Ord, Show)--class AsDegreesLongitude p f s where- _DegreesLongitude ::- Optic' p f s DegreesLongitude--instance AsDegreesLongitude p f DegreesLongitude where- _DegreesLongitude =- id---- | A prism on degrees longitude to an integer between -180 and 180 exclusive.------ >>> (7 :: Int) ^? _DegreesLongitude--- Just (DegreesLongitude 7)------ >>> (0 :: Int) ^? _DegreesLongitude--- Just (DegreesLongitude 0)------ >>> (179 :: Int) ^? _DegreesLongitude--- Just (DegreesLongitude 179)------ >>> (180 :: Int) ^? _DegreesLongitude--- Nothing------ >>> (-179 :: Int) ^? _DegreesLongitude--- Just (DegreesLongitude (-179))------ >>> (-180 :: Int) ^? _DegreesLongitude--- Nothing------ prop> all (\m -> _DegreesLongitude # m == (n :: Int)) (n ^? _DegreesLongitude)-instance (Choice p, Applicative f) => AsDegreesLongitude p f Int where- _DegreesLongitude =- prism'- (\(DegreesLongitude i) -> i)- (\i -> if i > -180 && i < 180- then Just (DegreesLongitude i)- else Nothing)---- | Setting a value within the range @-180@ and @180@ using modulo arithmetic.------ >>> modDegreesLongitude 7--- DegreesLongitude 7------ >>> modDegreesLongitude 0--- DegreesLongitude 0------ >>> modDegreesLongitude 180--- DegreesLongitude 180------ >>> modDegreesLongitude (-180)--- DegreesLongitude (-180)------ >>> modDegreesLongitude 1--- DegreesLongitude 1------ >>> modDegreesLongitude 179--- DegreesLongitude 179 ------ >>> modDegreesLongitude 181--- DegreesLongitude (-179)------ >>> modDegreesLongitude (-181)--- DegreesLongitude 179------ >>> modDegreesLongitude 600--- DegreesLongitude (-120)------ >>> modDegreesLongitude (-600)--- DegreesLongitude 120-modDegreesLongitude ::- Int- -> DegreesLongitude-modDegreesLongitude x =- DegreesLongitude (if x == 180 then 180 else mod (x + 180) 360 - 180)---- | The degrees longitude that is symmetrical around the prime meridian.------ >>> antipodeDegreesLongitude # modDegreesLongitude 30--- DegreesLongitude (-30)------ >>> antipodeDegreesLongitude # modDegreesLongitude 100--- DegreesLongitude (-100)------ >>> antipodeDegreesLongitude # modDegreesLongitude 190--- DegreesLongitude 170------ >>> antipodeDegreesLongitude # modDegreesLongitude 0--- DegreesLongitude 0-antipodeDegreesLongitude ::- Iso'- DegreesLongitude- DegreesLongitude-antipodeDegreesLongitude =- let n (DegreesLongitude x) = DegreesLongitude (negate x)- in iso- n- n
− src/Data/Geo/Coordinate/Latitude.hs
@@ -1,213 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}--module Data.Geo.Coordinate.Latitude(- Latitude-, AsLatitude(..)-, modLatitude-, antipodeLatitude-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(Choice, Profunctor, Optic', Iso', iso, prism', lens, (#), (^?))-import Control.Monad(Monad(return))-import Data.Eq(Eq)-import Data.Fixed(divMod')-import Data.Functor(Functor)-import Data.Geo.Coordinate.DegreesLatitude(DegreesLatitude, AsDegreesLatitude(_DegreesLatitude), modDegreesLatitude, antipodeDegreesLatitude)-import Data.Geo.Coordinate.Minutes(AsMinutes(_Minutes), Minutes, modMinutes)-import Data.Geo.Coordinate.Seconds(AsSeconds(_Seconds), Seconds, modSeconds)-import Data.Ord(Ord((<)))-import Prelude(Double, Show, Int, Num((+), (*), (-), abs), Fractional((/)), properFraction, fromIntegral)---- $setup--- >>> import Prelude(Functor(..))--- >>> import Data.Maybe--data Latitude =- Latitude- DegreesLatitude- Minutes- Seconds- deriving (Eq, Ord, Show)--class AsLatitude p f s where- _Latitude ::- Optic' p f s Latitude--instance AsLatitude p f Latitude where- _Latitude =- id---- | An isomorphism on the triple of degrees latitude, minutes, seconds to a latitude.------ >>> do deg <- (7 :: Int) ^? _DegreesLatitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 7) (Minutes 7) (Seconds 7.0000))------ >>> do deg <- (89 :: Int) ^? _DegreesLatitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 89) (Minutes 59) (Seconds 59.0000))------ >>> do deg <- (-7 :: Int) ^? _DegreesLatitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude (-7)) (Minutes 7) (Seconds 7.0000))------ >>> do deg <- (-89 :: Int) ^? _DegreesLatitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude (-89)) (Minutes 59) (Seconds 59.0000))------ >>> do deg <- (90 :: Int) ^? _DegreesLatitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Nothing------ >>> do deg <- (89 :: Int) ^? _DegreesLatitude; min <- (60 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Nothing------ >>> do deg <- (89 :: Int) ^? _DegreesLatitude; min <- (59 :: Int) ^? _Minutes; sec <- (60 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude--- Nothing------ >>> fmap (\x -> _Latitude # x :: (DegreesLatitude, Minutes, Seconds)) ((7 :: Double) ^? _Latitude :: Maybe Latitude)--- Just (DegreesLatitude 7,Minutes 0,Seconds 0.0000)------ >>> fmap (\x -> _Latitude # x :: (DegreesLatitude, Minutes, Seconds)) ((7.12 :: Double) ^? _Latitude :: Maybe Latitude)--- Just (DegreesLatitude 7,Minutes 7,Seconds 12.0000)-instance (Profunctor p, Functor f) => AsLatitude p f (DegreesLatitude, Minutes, Seconds) where- _Latitude =- iso (\(d, m, s) -> Latitude d m s) (\(Latitude d m s) -> (d, m, s))---- | A prism on latitude to a double between -90 and 90 exclusive.------ >>> (7 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 7) (Minutes 0) (Seconds 0.0000))------ >>> (-7 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude (-7)) (Minutes 0) (Seconds 0.0000))------ >>> (7.12 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 7) (Minutes 7) (Seconds 12.0000))------ >>> (-7.12 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude (-7)) (Minutes 7) (Seconds 12.0000))------ >>> fmap (\x -> _Latitude # x :: Double) ((7.12 :: Double) ^? _Latitude :: Maybe Latitude)--- Just 7.12------ >>> fmap (\x -> _Latitude # x :: Double) ((-7.12 :: Double) ^? _Latitude :: Maybe Latitude)--- Just (-7.12)------ >>> (90 :: Double) ^? _Latitude :: Maybe Latitude--- Nothing------ >>> (-90 :: Double) ^? _Latitude :: Maybe Latitude--- Nothing------ >>> (15.63791 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 15) (Minutes 38) (Seconds 16.4760))------ >>> (89.1 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 89) (Minutes 5) (Seconds 60.0000))------ >>> (89.2 :: Double) ^? _Latitude :: Maybe Latitude--- Just (Latitude (DegreesLatitude 89) (Minutes 12) (Seconds 0.0000))------ >>> fmap (\x -> _Latitude # x :: Double) (do deg <- (7 :: Int) ^? _DegreesLatitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude)--- Just 7.118611111111111------ >>> fmap (\x -> _Latitude # x :: Double) (do deg <- (89 :: Int) ^? _DegreesLatitude; min <- (15 :: Int) ^? _Minutes; sec <- (6 :: Double) ^? _Seconds; (deg, min, sec) ^? _Latitude :: Maybe Latitude)--- Just 89.25166666666667-instance (Choice p, Applicative f) => AsLatitude p f Double where- _Latitude =- prism' (\(Latitude d m s) ->- let p = fromIntegral (_DegreesLatitude # d :: Int)- q = (fromIntegral (_Minutes # m :: Int) / 60) + (_Seconds # s) / 3600- in (if p < 0 then (-) else (+)) p q)- (\x -> let (d, z) = properFraction x- (m, s) = properFraction ((z :: Double) * 60)- in do d' <- (d :: Int) ^? _DegreesLatitude- m' <- (abs m :: Int) ^? _Minutes- s' <- (abs s * 60) ^? _Seconds- return (Latitude d' m' s'))--instance (p ~ (->), Functor f) => AsDegreesLatitude p f Latitude where- _DegreesLatitude =- lens (\(Latitude d _ _) -> d) (\(Latitude _ m s) d -> Latitude d m s)--instance (p ~ (->), Functor f) => AsMinutes p f Latitude where- _Minutes =- lens (\(Latitude _ m _) -> m) (\(Latitude d _ s) m -> Latitude d m s)--instance (p ~ (->), Functor f) => AsSeconds p f Latitude where- _Seconds =- lens (\(Latitude _ _ s) -> s) (\(Latitude d m _) s -> Latitude d m s)---- | Setting a latitude using modulo arithmetic.------ >>> modLatitude 20 20 20--- Latitude (DegreesLatitude 20) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 20 20 (-20)--- Latitude (DegreesLatitude 20) (Minutes 19) (Seconds 40.0000)------ >>> modLatitude 20 20 80--- Latitude (DegreesLatitude 20) (Minutes 21) (Seconds 20.0000)------ >>> modLatitude 20 80 20--- Latitude (DegreesLatitude 21) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 20 80 80--- Latitude (DegreesLatitude 21) (Minutes 21) (Seconds 20.0000)------ >>> modLatitude 20 80 (-20)--- Latitude (DegreesLatitude 21) (Minutes 19) (Seconds 40.0000)------ >>> modLatitude 110 20 20--- Latitude (DegreesLatitude (-70)) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 110 20 80--- Latitude (DegreesLatitude (-70)) (Minutes 21) (Seconds 20.0000)------ >>> modLatitude 110 80 20--- Latitude (DegreesLatitude (-69)) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 110 20 (-20)--- Latitude (DegreesLatitude (-70)) (Minutes 19) (Seconds 40.0000)------ >>> modLatitude 110 (-20) (-20)--- Latitude (DegreesLatitude (-71)) (Minutes 39) (Seconds 40.0000)------ >>> modLatitude 110 (-80) (-20)--- Latitude (DegreesLatitude (-72)) (Minutes 39) (Seconds 40.0000)------ >>> modLatitude 20 20 3620--- Latitude (DegreesLatitude 21) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 20 20 (-3580)--- Latitude (DegreesLatitude 19) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 110 20 3620--- Latitude (DegreesLatitude (-69)) (Minutes 20) (Seconds 20.0000)------ >>> modLatitude 110 20 (-3580)--- Latitude (DegreesLatitude (-71)) (Minutes 20) (Seconds 20.0000)-modLatitude ::- Int- -> Int- -> Double- -> Latitude-modLatitude d m s =- let (ts, rs) = s `divMod'` 60- (tm, rm) = (ts + m) `divMod'` 60- in Latitude (modDegreesLatitude (tm + d)) (modMinutes rm) (modSeconds rs)---- | The latitude that is symmetrical around the equator.------ >>> fmap (\x -> antipodeLatitude # x) (do d <- (7 :: Int) ^? _DegreesLatitude; m <- (7 :: Int) ^? _Minutes; s <- (7 :: Double) ^? _Seconds; (d, m, s) ^? _Latitude :: Maybe Latitude)--- Just (Latitude (DegreesLatitude (-7)) (Minutes 7) (Seconds 7.0000))-antipodeLatitude ::- Iso'- Latitude- Latitude-antipodeLatitude =- let n (Latitude d m s) = Latitude (antipodeDegreesLatitude # d) m s- in iso- n- n
− src/Data/Geo/Coordinate/Longitude.hs
@@ -1,213 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}--module Data.Geo.Coordinate.Longitude(- Longitude-, AsLongitude(..)-, modLongitude-, antipodeLongitude-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(Choice, Profunctor, Optic', Iso', iso, prism', lens, (#), (^?))-import Control.Monad(Monad(return))-import Data.Eq(Eq)-import Data.Fixed(divMod')-import Data.Functor(Functor)-import Data.Geo.Coordinate.DegreesLongitude(DegreesLongitude, AsDegreesLongitude(_DegreesLongitude), modDegreesLongitude, antipodeDegreesLongitude)-import Data.Geo.Coordinate.Minutes(AsMinutes(_Minutes), Minutes, modMinutes)-import Data.Geo.Coordinate.Seconds(AsSeconds(_Seconds), Seconds, modSeconds)-import Data.Ord(Ord((<)))-import Prelude(Double, Show, Int, Num((+), (*), (-), abs), Fractional((/)), properFraction, fromIntegral)---- $setup--- >>> import Prelude(Functor(..))--- >>> import Data.Maybe--data Longitude =- Longitude- DegreesLongitude- Minutes- Seconds- deriving (Eq, Ord, Show)--class AsLongitude p f s where- _Longitude ::- Optic' p f s Longitude--instance AsLongitude p f Longitude where- _Longitude =- id---- | An isomorphism on the triple of degrees longitude, minutes, seconds to a longitude.------ >>> do deg <- (7 :: Int) ^? _DegreesLongitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 7) (Minutes 7) (Seconds 7.0000))------ >>> do deg <- (179 :: Int) ^? _DegreesLongitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 179) (Minutes 59) (Seconds 59.0000))------ >>> do deg <- (-7 :: Int) ^? _DegreesLongitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude (-7)) (Minutes 7) (Seconds 7.0000))------ >>> do deg <- (-179 :: Int) ^? _DegreesLongitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude (-179)) (Minutes 59) (Seconds 59.0000))------ >>> do deg <- (180 :: Int) ^? _DegreesLongitude; min <- (59 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Nothing------ >>> do deg <- (179 :: Int) ^? _DegreesLongitude; min <- (60 :: Int) ^? _Minutes; sec <- (59 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Nothing------ >>> do deg <- (179 :: Int) ^? _DegreesLongitude; min <- (59 :: Int) ^? _Minutes; sec <- (60 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude--- Nothing------ >>> fmap (\x -> _Longitude # x :: (DegreesLongitude, Minutes, Seconds)) ((7 :: Double) ^? _Longitude :: Maybe Longitude)--- Just (DegreesLongitude 7,Minutes 0,Seconds 0.0000)------ >>> fmap (\x -> _Longitude # x :: (DegreesLongitude, Minutes, Seconds)) ((7.12 :: Double) ^? _Longitude :: Maybe Longitude)--- Just (DegreesLongitude 7,Minutes 7,Seconds 12.0000)-instance (Profunctor p, Functor f) => AsLongitude p f (DegreesLongitude, Minutes, Seconds) where- _Longitude =- iso (\(d, m, s) -> Longitude d m s) (\(Longitude d m s) -> (d, m, s))---- | A prism on longitude to a double between -180 and 180 exclusive.------ >>> (7 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 7) (Minutes 0) (Seconds 0.0000))------ >>> (-7 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude (-7)) (Minutes 0) (Seconds 0.0000))------ >>> (7.12 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 7) (Minutes 7) (Seconds 12.0000))------ >>> (-7.12 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude (-7)) (Minutes 7) (Seconds 12.0000))------ >>> fmap (\x -> _Longitude # x :: Double) ((7.12 :: Double) ^? _Longitude :: Maybe Longitude)--- Just 7.12------ >>> fmap (\x -> _Longitude # x :: Double) ((-7.12 :: Double) ^? _Longitude :: Maybe Longitude)--- Just (-7.12)------ >>> (180 :: Double) ^? _Longitude :: Maybe Longitude--- Nothing------ >>> (-180 :: Double) ^? _Longitude :: Maybe Longitude--- Nothing------ >>> (15.63791 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 15) (Minutes 38) (Seconds 16.4760))------ >>> (179.1 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 179) (Minutes 5) (Seconds 60.0000))------ >>> (179.2 :: Double) ^? _Longitude :: Maybe Longitude--- Just (Longitude (DegreesLongitude 179) (Minutes 11) (Seconds 60.0000))------ >>> fmap (\x -> _Longitude # x :: Double) (do deg <- (7 :: Int) ^? _DegreesLongitude; min <- (7 :: Int) ^? _Minutes; sec <- (7 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude)--- Just 7.118611111111111------ >>> fmap (\x -> _Longitude # x :: Double) (do deg <- (179 :: Int) ^? _DegreesLongitude; min <- (15 :: Int) ^? _Minutes; sec <- (6 :: Double) ^? _Seconds; (deg, min, sec) ^? _Longitude :: Maybe Longitude)--- Just 179.25166666666667-instance (Choice p, Applicative f) => AsLongitude p f Double where- _Longitude =- prism' (\(Longitude d m s) ->- let p = fromIntegral (_DegreesLongitude # d :: Int)- q = (fromIntegral (_Minutes # m :: Int) / 60) + (_Seconds # s) / 3600- in (if p < 0 then (-) else (+)) p q)- (\x -> let (d, z) = properFraction x- (m, s) = properFraction ((z :: Double) * 60)- in do d' <- (d :: Int) ^? _DegreesLongitude- m' <- (abs m :: Int) ^? _Minutes- s' <- (abs s * 60) ^? _Seconds- return (Longitude d' m' s'))--instance (p ~ (->), Functor f) => AsDegreesLongitude p f Longitude where- _DegreesLongitude =- lens (\(Longitude d _ _) -> d) (\(Longitude _ m s) d -> Longitude d m s)- -instance (p ~ (->), Functor f) => AsMinutes p f Longitude where- _Minutes =- lens (\(Longitude _ m _) -> m) (\(Longitude d _ s) m -> Longitude d m s)--instance (p ~ (->), Functor f) => AsSeconds p f Longitude where- _Seconds =- lens (\(Longitude _ _ s) -> s) (\(Longitude d m _) s -> Longitude d m s)---- | Setting a longitude using modulo arithmetic.------ >>> modLongitude 20 20 20--- Longitude (DegreesLongitude 20) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 20 20 (-20)--- Longitude (DegreesLongitude 20) (Minutes 19) (Seconds 40.0000)------ >>> modLongitude 20 20 80--- Longitude (DegreesLongitude 20) (Minutes 21) (Seconds 20.0000)------ >>> modLongitude 20 80 20--- Longitude (DegreesLongitude 21) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 20 80 80--- Longitude (DegreesLongitude 21) (Minutes 21) (Seconds 20.0000)------ >>> modLongitude 20 80 (-20)--- Longitude (DegreesLongitude 21) (Minutes 19) (Seconds 40.0000)------ >>> modLongitude 200 20 20--- Longitude (DegreesLongitude (-160)) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 200 20 80--- Longitude (DegreesLongitude (-160)) (Minutes 21) (Seconds 20.0000)------ >>> modLongitude 200 80 20--- Longitude (DegreesLongitude (-159)) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 200 20 (-20)--- Longitude (DegreesLongitude (-160)) (Minutes 19) (Seconds 40.0000)------ >>> modLongitude 200 (-20) (-20)--- Longitude (DegreesLongitude (-161)) (Minutes 39) (Seconds 40.0000)------ >>> modLongitude 200 (-80) (-20)--- Longitude (DegreesLongitude (-162)) (Minutes 39) (Seconds 40.0000)------ >>> modLongitude 20 20 3620--- Longitude (DegreesLongitude 21) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 20 20 (-3580)--- Longitude (DegreesLongitude 19) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 200 20 3620--- Longitude (DegreesLongitude (-159)) (Minutes 20) (Seconds 20.0000)------ >>> modLongitude 200 20 (-3580)--- Longitude (DegreesLongitude (-161)) (Minutes 20) (Seconds 20.0000)-modLongitude ::- Int- -> Int- -> Double- -> Longitude-modLongitude d m s =- let (ts, rs) = s `divMod'` 60- (tm, rm) = (ts + m) `divMod'` 60- in Longitude (modDegreesLongitude (tm + d)) (modMinutes rm) (modSeconds rs)---- | The longitude that is symmetrical around the prime meridian.------ >>> fmap (\x -> antipodeLongitude # x) (do d <- (7 :: Int) ^? _DegreesLongitude; m <- (7 :: Int) ^? _Minutes; s <- (7 :: Double) ^? _Seconds; (d, m, s) ^? _Longitude :: Maybe Longitude)--- Just (Longitude (DegreesLongitude (-7)) (Minutes 7) (Seconds 7.0000))-antipodeLongitude ::- Iso'- Longitude- Longitude-antipodeLongitude =- let n (Longitude d m s) = Longitude (antipodeDegreesLongitude # d) m s- in iso- n- n
− src/Data/Geo/Coordinate/Minutes.hs
@@ -1,87 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Geo.Coordinate.Minutes(- Minutes-, AsMinutes(..)-, modMinutes-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(Optic', Choice, prism')-import Data.Bool((&&))-import Data.Maybe(Maybe(Just, Nothing))-import Data.Eq(Eq)-import Data.Int(Int)-import Data.Ord(Ord((>=), (<)))-import Prelude(Show, mod)---- $setup--- >>> import Control.Lens((#), (^?), (^.))--- >>> import Data.Foldable(all)--- >>> import Prelude(Eq(..))--newtype Minutes =- Minutes Int- deriving (Eq, Ord, Show)--class AsMinutes p f s where- _Minutes ::- Optic' p f s Minutes--instance AsMinutes p f Minutes where- _Minutes =- id---- | A prism on minutes to an integer between 0 and 59 inclusive.------ >>> (7 :: Int) ^? _Minutes--- Just (Minutes 7)------ >>> (0 :: Int) ^? _Minutes--- Just (Minutes 0)------ >>> (59 :: Int) ^? _Minutes--- Just (Minutes 59)------ >>> (60 :: Int) ^? _Minutes--- Nothing------ prop> all (\m -> _Minutes # m == (n :: Int)) (n ^? _Minutes)-instance (Choice p, Applicative f) => AsMinutes p f Int where- _Minutes =- prism'- (\(Minutes i) -> i)- (\i -> if i >= 0 && i < 60- then Just (Minutes i)- else Nothing) ---- | Setting a value within the range @0@ and @60@ using modulo arithmetic.------ >>> modMinutes 7--- Minutes 7------ >>> modMinutes 0--- Minutes 0------ >>> modMinutes 60--- Minutes 0------ >>> modMinutes 1--- Minutes 1------ >>> modMinutes 59--- Minutes 59 ------ >>> modMinutes 61--- Minutes 1------ >>> modMinutes (-1)--- Minutes 59-modMinutes ::- Int- -> Minutes-modMinutes x =- Minutes (x `mod` 60)
− src/Data/Geo/Coordinate/Seconds.hs
@@ -1,103 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Geo.Coordinate.Seconds(- Seconds-, AsSeconds(..)-, modSeconds-) where--import Control.Applicative(Applicative)-import Control.Category(Category(id))-import Control.Lens(prism', Optic', Choice)-import Data.Bool((&&))-import Data.Eq(Eq)-import Data.Int(Int)-import Data.Fixed(divMod')-import Data.Ord(Ord((>), (>=), (<)))-import Data.Maybe(Maybe(Just, Nothing))-import Data.List((++))-import Data.Tuple(snd)-import Prelude(Double, Show(showsPrec), showParen, showString)-import Text.Printf(printf)---- $setup--- >>> import Control.Lens((#), (^?), (^.))--- >>> import Data.Foldable(all)--- >>> import Prelude(Eq(..))--newtype Seconds =- Seconds Double- deriving (Eq, Ord)---- | A show instance that prints to 4 decimal places.--- This is to take floating-point rounding errors into account.-instance Show Seconds where- showsPrec n (Seconds d) =- showParen (n > 10) (showString ("Seconds " ++ printf "%0.4f" d))--class AsSeconds p f s where- _Seconds ::- Optic' p f s Seconds--instance AsSeconds p f Seconds where- _Seconds =- id---- | A prism on seconds to a double between 0 inclusive and 60 exclusive.------ >>> (7 :: Double) ^? _Seconds--- Just (Seconds 7.0000)------ >>> (0 :: Double) ^? _Seconds--- Just (Seconds 0.0000)------ >>> (59 :: Double) ^? _Seconds--- Just (Seconds 59.0000)------ >>> (59.99 :: Double) ^? _Seconds--- Just (Seconds 59.9900)------ >>> (60 :: Double) ^? _Seconds--- Nothing------ prop> all (\m -> _Seconds # m == (n :: Double)) (n ^? _Seconds)-instance (Choice p, Applicative f) => AsSeconds p f Double where- _Seconds =- prism'- (\(Seconds d) -> d)- (\d -> if d >= 0 && d < 60- then Just (Seconds d)- else Nothing)---- | Setting a value within the range @0@ and @60@ using modulo arithmetic.------ >>> modSeconds 7--- Seconds 7.0000------ >>> modSeconds 0--- Seconds 0.0000------ >>> modSeconds (-0.0001)--- Seconds 59.9999------ >>> modSeconds 60--- Seconds 0.0000------ >>> modSeconds 59.99999--- Seconds 60.0000------ >>> modSeconds 59.999--- Seconds 59.9990------ >>> modSeconds 61--- Seconds 1.0000------ >>> modSeconds (-1)--- Seconds 59.0000-modSeconds ::- Double- -> Seconds-modSeconds x =- Seconds (snd (x `divMod'` 60.0 :: (Int, Double)))
+ src/Data/Geodetic.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Geodetic(+ module G+) where++import Data.Geodetic.ECEF as G+import Data.Geodetic.Ellipsoid as G+import Data.Geodetic.EllipsoidReaderT as G+import Data.Geodetic.HasDoubles as G+import Data.Geodetic.LLH as G+import Data.Geodetic.LL as G+import Data.Geodetic.XY as G
+ src/Data/Geodetic/ECEF.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Geodetic.ECEF(+ ECEF(..)+, HasECEF(..)+) where++import Control.Applicative(Applicative((<*>)))+import Control.Lens(makeClassy, lens)+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Geodetic.HasDoubles(HasDoubles(doubles))+import Data.Geodetic.XY(XY, HasXY(xY))+import Data.Ord(Ord)+import Prelude(Show, Double)++data ECEF =+ ECEF {+ _xy ::+ XY+ , _z ::+ Double+ }+ deriving (Eq, Ord, Show)++makeClassy ''ECEF++instance HasXY ECEF where+ xY =+ lens+ (\(ECEF xy_ _) -> xy_)+ (\(ECEF _ z_) xy_ -> ECEF xy_ z_)++instance HasDoubles ECEF where+ doubles f (ECEF xy_ z_) =+ ECEF <$>+ doubles f xy_ <*>+ f z_
+ src/Data/Geodetic/Ellipsoid.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Geodetic.Ellipsoid(+ Ellipsoid(..)+, HasEllipsoid(..)+, flatteningReciprocal+, wgs84+) where++import Control.Applicative(Applicative((<*>)))+import Control.Category((.))+import Control.Lens(makeClassy, Lens', involuted)+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Geodetic.HasDoubles(HasDoubles(doubles))+import Data.Ord(Ord)+import Prelude(Show, Double, (/))++data Ellipsoid =+ Ellipsoid {+ _semiMajor ::+ Double+ , _flattening ::+ Double+ } deriving (Eq, Ord, Show)++makeClassy ''Ellipsoid++instance HasDoubles Ellipsoid where+ doubles f (Ellipsoid s l) =+ Ellipsoid <$> f s <*> f l++flatteningReciprocal ::+ HasEllipsoid e =>+ Lens'+ e+ Double+flatteningReciprocal =+ flattening . involuted (1/)++wgs84 ::+ Ellipsoid+wgs84 =+ Ellipsoid+ 6378137+ 298.257223563
+ src/Data/Geodetic/EllipsoidReaderT.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FunctionalDependencies #-}++module Data.Geodetic.EllipsoidReaderT(+ EllipsoidReaderT(..)+, EllipsoidReader+, runEllipsoidReader+, toEllipsoidReaderT+, hoistEllipsoidReader+, arrEllipsoidReader+, readEllipsoid+, readSemiMajor+, readFlattening+, readFlatteningReciprocal+, semiMinor+, eccentricitySquared+, eccentricitySquared'+, distributeNormal+, normal+, wgs84'+, wgs84''+, earthGeo+) where++import Control.Category((.))+import Control.Applicative(Applicative((<*>), pure), liftA2, Alternative((<|>), empty))+import Control.Lens(makeWrapped, (#), _Unwrapped, ReifiedIso', ReifiedIso(Iso), Iso', iso, from, (^.), (&), Wrapped(_Wrapped'))+import Control.Monad(Monad((>>=), return), MonadPlus(mzero, mplus))+import Control.Monad.Fix(MonadFix(mfix))+import Control.Monad.IO.Class(MonadIO(liftIO))+import Control.Monad.Trans.Class(MonadTrans(lift))+import Control.Monad.Trans.Reader(ReaderT)+import Control.Monad.Zip(MonadZip(mzip))+import Data.Functor(Functor(fmap), (<$>))+import Data.Functor.Identity(Identity(Identity, runIdentity))+import Data.Geodetic.ECEF(ECEF(..), HasECEF(z))+import Data.Geodetic.Ellipsoid(Ellipsoid, HasEllipsoid(semiMajor, flattening), flatteningReciprocal, wgs84)+import Data.Geodetic.LL(LL(LL), HasLL(lat, lon))+import Data.Geodetic.LLH(LLH(LLH), HasLLH(height))+import Data.Geodetic.XY(XY(XY), HasXY(x, y))+import Data.Int(Int)+import Prelude(Double, Num((*), (+), (-)), Fractional((/)), Floating(sin, cos, sqrt, atan, (**)), RealFloat(atan2), (^))++-- $setup+-- >>> import Control.Lens(ReifiedIso(runIso))+-- >>> import Data.Geodetic.Ellipsoid++newtype EllipsoidReaderT f a =+ EllipsoidReaderT (Ellipsoid -> f a)++makeWrapped ''EllipsoidReaderT++type EllipsoidReader a =+ EllipsoidReaderT Identity a++runEllipsoidReader ::+ Iso'+ (EllipsoidReader a)+ (Ellipsoid -> a)+runEllipsoidReader =+ iso+ (\(EllipsoidReaderT k) -> runIdentity . k)+ (\k -> EllipsoidReaderT (Identity . k))++toEllipsoidReaderT ::+ Iso'+ (EllipsoidReaderT f a)+ (ReaderT Ellipsoid f a)+toEllipsoidReaderT =+ from (_Wrapped' . from _Wrapped')++hoistEllipsoidReader ::+ Applicative f =>+ EllipsoidReader a+ -> EllipsoidReaderT f a+hoistEllipsoidReader (EllipsoidReaderT k) =+ EllipsoidReaderT (pure . runIdentity . k)++arrEllipsoidReader ::+ Applicative f =>+ (Ellipsoid -> a)+ -> EllipsoidReaderT f a+arrEllipsoidReader k =+ EllipsoidReaderT (pure . k)++instance Functor f => Functor (EllipsoidReaderT f) where+ fmap f (EllipsoidReaderT k) =+ EllipsoidReaderT (fmap f . k)++instance Applicative f => Applicative (EllipsoidReaderT f) where+ pure =+ EllipsoidReaderT . pure . pure+ EllipsoidReaderT f <*> EllipsoidReaderT a =+ EllipsoidReaderT (liftA2 (<*>) f a)++instance Monad f => Monad (EllipsoidReaderT f) where+ return =+ EllipsoidReaderT . return . return+ EllipsoidReaderT k >>= f =+ EllipsoidReaderT (\e -> k e >>= \q -> e & f q ^. _Wrapped')++instance Alternative f => Alternative (EllipsoidReaderT f) where+ empty =+ EllipsoidReaderT (\_ -> empty)+ EllipsoidReaderT a <|> EllipsoidReaderT b =+ EllipsoidReaderT (liftA2 (<|>) a b)++instance MonadPlus f => MonadPlus (EllipsoidReaderT f) where+ mzero =+ EllipsoidReaderT (\_ -> mzero)+ EllipsoidReaderT a `mplus` EllipsoidReaderT b =+ EllipsoidReaderT (liftA2 mplus a b)++instance MonadTrans EllipsoidReaderT where+ lift =+ EllipsoidReaderT . pure++instance MonadIO f => MonadIO (EllipsoidReaderT f) where+ liftIO =+ EllipsoidReaderT . pure . liftIO ++instance MonadFix f => MonadFix (EllipsoidReaderT f) where+ mfix f =+ EllipsoidReaderT (\e -> mfix (\q -> e & f q ^. _Wrapped'))++instance MonadZip f => MonadZip (EllipsoidReaderT f) where+ EllipsoidReaderT a `mzip` EllipsoidReaderT b =+ EllipsoidReaderT (liftA2 mzip a b)++readEllipsoid ::+ Applicative f =>+ EllipsoidReaderT f Ellipsoid+readEllipsoid =+ EllipsoidReaderT pure++readSemiMajor ::+ Applicative f =>+ EllipsoidReaderT f Double+readSemiMajor =+ (^. semiMajor) <$> readEllipsoid++readFlattening ::+ Applicative f =>+ EllipsoidReaderT f Double+readFlattening =+ (^. flattening) <$> readEllipsoid++readFlatteningReciprocal ::+ Applicative f =>+ EllipsoidReaderT f Double+readFlatteningReciprocal =+ (^. flatteningReciprocal) <$> readEllipsoid++semiMinor ::+ Applicative f =>+ EllipsoidReaderT f Double+semiMinor =+ (\f m -> m * (1 - f)) <$>+ readFlatteningReciprocal <*>+ readSemiMajor++-- |+--+-- >>> wgs84' eccentricitySquared+-- 6.6943799901413165e-3+eccentricitySquared ::+ Applicative f =>+ EllipsoidReaderT f Double+eccentricitySquared =+ (\f -> 2 * f - (f * f)) <$> readFlatteningReciprocal++-- |+--+-- >>> wgs84' eccentricitySquared'+-- 6.694455244784511e-3+eccentricitySquared' ::+ Applicative f => + EllipsoidReaderT f Double+eccentricitySquared' =+ (\f -> (f * (2 - f)) / (1 - f * f)) <$> readFlatteningReciprocal++distributeNormal ::+ Applicative f =>+ Double+ -> EllipsoidReaderT f Double+distributeNormal t =+ (\k -> k t) <$> normal++-- |+--+-- >>> wgs84' normal 7+-- 6387371.845852088+--+-- >>> wgs84' normal 71+-- 6397535.266650572+--+-- >>> wgs84' normal 711+-- 6393308.675975408+--+-- >>> wgs84' normal (-7)+-- 6387371.845852088+normal ::+ Applicative f =>+ EllipsoidReaderT f (Double -> Double)+normal =+ (\s m t -> m / sqrt (1 - s * sin t ^ (2 :: Int))) <$> eccentricitySquared <*> readSemiMajor++wgs84' ::+ EllipsoidReader a+ -> a+wgs84' r =+ (r ^. runEllipsoidReader) wgs84++wgs84'' ::+ EllipsoidReaderT f a+ -> f a+wgs84'' r =+ (_Unwrapped # r) wgs84++-- |+--+-- >>> ECEF (XY (-5019624) 2618621) (-2927516) ^. runIso (wgs84' earthGeo)+-- LLH {ll = LL {_lat = -0.4799654447089294, _lon = 2.66075442877903}, _height = 100.20987554546446}+--+-- >>> ECEF (XY 9919623 (-3116612)) (-2396517) ^. runIso (wgs84' earthGeo)+-- LLH {ll = LL {_lat = -0.22740831363634992, _lon = -0.30442061911398305}, _height = 4293252.6636643605}+--+-- >>> LLH (LL 0.48 2.661) 100 ^. from (runIso (wgs84' earthGeo))+-- ECEF {_xy = XY {_x = -5020176.908575072, _y = 2617341.3240995244}, _z = 2927710.5079646683}+--+-- >>> LLH (LL (-0.22741) (-0.30442)) 4293252.66 ^. from (runIso (wgs84' earthGeo))+-- ECEF {_xy = XY {_x = 9919621.069754401, _y = -3116604.645933256}, _z = -2396534.4668575544}+earthGeo ::+ Applicative f =>+ EllipsoidReaderT f (ReifiedIso' ECEF LLH)+earthGeo =+ let f e2 a nt =+ Iso (+ iso+ (\ecef -> + let + x_ = ecef ^. x+ y_ = ecef ^. y+ h_ = ecef ^. z+ sq q = q ^ (2 :: Int)+ p2 = sq x_ + sq y_+ a2 = sq a+ e4 = sq e2+ zeta = (1 - e2) * (sq h_ / a2)+ rho = (p2 / a2 + zeta - e4) / 6+ rho2 = sq rho+ rho3 = rho * rho2+ s = e4 * zeta * p2 / (4 * a2)+ cbrt q = q ** (1 / 3)+ t = cbrt (s + rho3 + sqrt (s * (s + 2 * rho3)))+ u = rho + t + rho2 / t+ v = sqrt (sq u + e4 * zeta)+ w = e2 * (u + v - zeta) / (2 * v)+ kappa = 1 + e2 * (sqrt (u + v + sq w) + w) / (u + v)+ phi = atan (kappa * h_ / sqrt p2)+ norm = nt phi+ l = h_ + e2 * norm * sin phi+ in LLH (LL phi (atan2 y_ x_)) (sqrt (l ^ (2 :: Int) + p2) - norm))+ (\llh ->+ let t_ = llh ^. lat+ n_ = llh ^. lon+ h_ = llh ^. height+ n = nt t_+ cs k = (n + h_) * cos t_ * k n_+ z_ = (n * (1 - e2) + h_) * sin t_+ in ECEF (XY (cs cos) (cs sin)) z_)+ )+ in f <$>+ eccentricitySquared <*>+ readSemiMajor <*>+ normal
+ src/Data/Geodetic/HasDoubles.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Geodetic.HasDoubles where++import Control.Category(id)+import Control.Lens(Traversal')+import Prelude(Double)++class HasDoubles a where+ doubles ::+ Traversal' a Double++instance HasDoubles Double where+ doubles =+ id
+ src/Data/Geodetic/LL.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FunctionalDependencies #-}++module Data.Geodetic.LL where++import Control.Applicative(Applicative((<*>)))+import Control.Lens(makeClassy)+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Geodetic.HasDoubles(HasDoubles(doubles))+import Data.Ord(Ord)+import Prelude(Show, Double)++data LL =+ LL {+ _lat ::+ Double -- radians+ , _lon ::+ Double -- radians+ }+ deriving (Eq, Ord, Show)++makeClassy ''LL++instance HasDoubles LL where+ doubles f (LL a o) =+ LL <$>+ f a <*>+ f o
+ src/Data/Geodetic/LLH.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FunctionalDependencies #-}++module Data.Geodetic.LLH where++import Control.Applicative(Applicative((<*>)))+import Control.Lens(makeClassy, lens)+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Geodetic.HasDoubles(HasDoubles(doubles))+import Data.Geodetic.LL+import Data.Ord(Ord)+import Prelude(Show, Double)++data LLH =+ LLH {+ ll ::+ LL+ , _height ::+ Double+ } deriving (Eq, Ord, Show)++makeClassy ''LLH++instance HasLL LLH where+ lL =+ lens+ ll+ (\(LLH _ h) l -> LLH l h)++instance HasDoubles LLH where+ doubles f (LLH l h) =+ LLH <$>+ doubles f l <*>+ f h
+ src/Data/Geodetic/XY.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Geodetic.XY where++import Control.Applicative(Applicative((<*>)))+import Control.Lens(makeClassy)+import Data.Eq(Eq)+import Data.Functor((<$>))+import Data.Geodetic.HasDoubles(HasDoubles(doubles))+import Data.Ord(Ord)+import Prelude(Show, Double)++data XY =+ XY {+ _x ::+ Double+ , _y ::+ Double+ }+ deriving (Eq, Ord, Show)++makeClassy ''XY++instance HasDoubles XY where+ doubles f (XY x_ y_) =+ XY <$>+ f x_ <*>+ f y_