naqsha 0.2.0.1 → 0.3.0.0
raw patch · 20 files changed
+1198/−940 lines, 20 filesdep +hspec-discoverdep ~basedep ~bytestringdep ~vectorPVP ok
version bump matches the API change (PVP)
Dependencies added: hspec-discover
Dependency ranges changed: base, bytestring, vector
API changes (from Hackage documentation)
+ Naqsha.Geometry.Internal: instance GHC.Base.Semigroup Naqsha.Geometry.Internal.Angle
+ Naqsha.Geometry.Internal: instance GHC.Base.Semigroup Naqsha.Geometry.Internal.Longitude
Files
- CHANGELOG.md +9/−0
- LICENSE +0/−30
- LICENSE-APACHE-2.0 +202/−0
- LICENSE-BSD3 +30/−0
- Naqsha/Geometry.hs +0/−62
- Naqsha/Geometry/Angle.hs +0/−26
- Naqsha/Geometry/Coordinate.hs +0/−195
- Naqsha/Geometry/Coordinate/GeoHash.hs +0/−214
- Naqsha/Geometry/Internal.hs +0/−311
- Naqsha/Geometry/Spherical.hs +0/−67
- Naqsha/Version.hs +0/−16
- README.md +22/−0
- geospatial/Naqsha/Geometry.hs +63/−0
- geospatial/Naqsha/Geometry/Angle.hs +26/−0
- geospatial/Naqsha/Geometry/Coordinate.hs +195/−0
- geospatial/Naqsha/Geometry/Coordinate/GeoHash.hs +214/−0
- geospatial/Naqsha/Geometry/Internal.hs +317/−0
- geospatial/Naqsha/Geometry/Spherical.hs +70/−0
- geospatial/Naqsha/Version.hs +16/−0
- naqsha.cabal +34/−19
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Change log for [naqsha] +## [0.3.0.0] - Pending++- moved to a multi-library package.+- license change from BSD-3-Clause to (Apache-2.0 OR BSD-3-Clause)+ dual licensing.+- tweaks to make it work with base 4.11.+ ## [0.2.0.1] - 24 July, 2017 - minor tweaks to make it build with older ghc (i.e. pre-"Monoids and Applicatives in Prelude)@@ -20,5 +27,7 @@ [naqsha]: <http://github.com/naqsha/naqsha/> "Naqsha library"+[0.2.0.2]: <https://github.com/naqsha/naqsha/releases/tag/v0.2.0.2> "Release 0.2.0.1"+[0.2.0.1]: <https://github.com/naqsha/naqsha/releases/tag/v0.2.0.1> "Release 0.2.0.1" [0.2.0.0]: <https://github.com/naqsha/naqsha/releases/tag/v0.2.0.0> "Release 0.2.0.0" [0.1.0.0]: <https://github.com/naqsha/naqsha/releases/tag/v0.1.0.0> "Release 0.1.0.0"
− LICENSE
@@ -1,30 +0,0 @@-Copyright (c) 2016, Piyush P Kurur--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 Piyush P Kurur 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.
+ LICENSE-APACHE-2.0 view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ LICENSE-BSD3 view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Piyush P Kurur++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 Piyush P Kurur 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.
− Naqsha/Geometry.hs
@@ -1,62 +0,0 @@--- | The geometric types and values exposed by naqsha.-module Naqsha.Geometry- ( module Naqsha.Geometry.Coordinate-- -- ** Angles and angular quantities.- , module Naqsha.Geometry.Angle-- -- * Geometric hashing.- -- $geohashing$-- -- * Distance calculation.- --- -- $distance$- ---- -- * Internal details- -- $internals$- ) where--import Naqsha.Geometry.Angle-import Naqsha.Geometry.Coordinate---- Nothing imported here. Only for docs.-import Naqsha.Geometry.Spherical()----- $geohashing$------ Geometric hashing is a technique of converting geometric--- coordinates into 1-dimension strings. Often these hashes ensures--- that string with large common prefix are close by (although not the--- converse). Hence, these hashes can be used to stored geo-cordinates--- in database and build into it a sense of location awareness. We support--- the following geometric hashing:------ ["Naqsha.Geometry.Coordinate.GeoHash":] The geohash standard--- (<https://en.wikipedia.org/wiki/Geohash>).------ None of these modules are imported by default the user may import--- the one that is most desirable.---- $distance$------ Calculating quantities like distance, bearing etc depends on the--- model of the globe that we choose. Even in a given model we might--- have different algorithms to compute the distance depending on--- speed-accuracy trade-offs. Choosing the correct model and--- algorithms is application dependent and hence we do not expose any--- default ones. The following modules can be imported depending on the need------ ["Naqsha.Geometry.Spherical": ] Assume a spherical model of the--- globe. Distance is calculated using the haversine formula.----- $internals$------ The basic types like `Latitude` or `Longitude` are exposed as--- opaque types from this module. For type safety, we encourage the--- users to use this module mostly when dealing with those times. For--- the rare case when some non-trivial operations need to be defined,--- we expose the internal module "Naqsha.Geometry.Internal". However,--- use this interface with caution.
− Naqsha/Geometry/Angle.hs
@@ -1,26 +0,0 @@--- | Basic types associated with geometry.-module Naqsha.Geometry.Angle- ( Angle- , degree , minute, second- , radian- , toDegree, toRadian- , Angular(..)- ) where--import Naqsha.Geometry.Internal-------------------------------- The angular class ---------------------------- | Angular quantities.-class Angular a where- toAngle :: a -> Angle--instance Angular Angle where- toAngle = id---instance Angular Latitude where- toAngle = unLat--instance Angular Longitude where- toAngle = unLong
− Naqsha/Geometry/Coordinate.hs
@@ -1,195 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE Rank2Types #-}--- | This module captures position of a point on the globe.-module Naqsha.Geometry.Coordinate- ( -- * Basics- -- $latandlong$- Geo(..)- , northPole, southPole- -- ** Latitudes- , Latitude- , lat, north, south- , equator- , tropicOfCancer- , tropicOfCapricon- -- ** Longitudes.- , Longitude- , lon, east, west- , greenwich- ) where--import Control.Monad ( liftM )-import Data.Group-import Data.Vector.Unboxed ( MVector(..), Vector)-import qualified Data.Vector.Generic as GV-import qualified Data.Vector.Generic.Mutable as GVM---import Prelude -- To avoid redundunt import warnings.--import Naqsha.Geometry.Angle-import Naqsha.Geometry.Internal------ $latandlong$------ A point on the globe is specified by giving its geo coordinates--- represented by the type `Geo`. It is essentially a pair of the--- `Latitude` and `Longitude` of the point.------ == Examples------ > kanpurLatitude :: Latitude--- > kanpurLatitude = lat $ degree 26.4477777--- > kanpurLongitude :: Longitude--- > kanpurLongitude = lon $ degree 80.3461111--- > kanpurGeo :: Geo--- > kanpurGeo = Geo kanpurLatitude kanpurLongitude------ You can also specify the latitude and longitude in units of degree,--- minute and seconds.------ > kanpurLatitude = lat $ degree 26 <> minute 26 <> second 52--- > kanpurLongitude = lon $ degree 80 <> minute 20 <> second 46------ The show and read instance of the `Latitude` and `Longitude` types--- uses degrees for displaying and reading respectively. Show and Read--- instances can express these quantities up to Nano degree precision.------ == Convention on sign.------ For latitudes, positive means north of the equator and negative--- means south. In the case of longitudes, positive means east of the--- longitude zero and negative means west. However, if you find these--- conventions confusing you can use the combinators `north`, `south`,--- `east`, and `west` when constructing latitudes or longitudes.-------- | Convert an angle to a northern latitude------ > tropicOfCancer = north $ degree 23.5----north :: Angle -> Latitude-north = lat---- | Convert an angle to a southern latitude.------ > tropicOfCapricon = south $ degree 23.5----south :: Angle -> Latitude-south = lat . invert----- | The latitude of equator.-equator :: Latitude-equator = lat $ degree 0---- | The latitude corresponding to the Tropic of Cancer.-tropicOfCancer :: Latitude-tropicOfCancer = north $ degree 23.5---- | The latitude corresponding to the Tropic of Capricon-tropicOfCapricon :: Latitude-tropicOfCapricon = south $ degree 23.5---- | Convert angle to an eastern longitude.------ > kanpurLongitude = east $ degree 80.3461----east :: Angle -> Longitude-east = lon---- | Convert angle to a western longitude------ > newyorkLongitude = west $ degree 74.0059----west :: Angle -> Longitude-west = lon . invert----- | The zero longitude.-greenwich :: Longitude-greenwich = lon $ degree 0---------------------- The geometric coordinates. --------------------- | The coordinates of a point on the earth's surface.-data Geo = Geo {-# UNPACK #-} !Latitude- {-# UNPACK #-} !Longitude- deriving Show----- | The North pole-northPole :: Geo-northPole = Geo maxBound $ lon $ degree 0---- | The South pole-southPole :: Geo-southPole = Geo minBound $ lon $ degree 0--instance Eq Geo where- (==) (Geo xlat xlong) (Geo ylat ylong)- | xlat == maxBound = ylat == maxBound -- longitude irrelevant for north pole- | xlat == minBound = ylat == minBound -- longitude irrelevant for south pole- | otherwise = xlat == ylat && xlong == ylong------------------------------- Vector Instance for Geo ------------------------------------------------newtype instance MVector s Geo = MGeoV (MVector s (Angle,Angle))-newtype instance Vector Geo = GeoV (Vector (Angle,Angle))---instance GVM.MVector MVector Geo where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MGeoV v) = GVM.basicLength v- basicUnsafeSlice i n (MGeoV v) = MGeoV $ GVM.basicUnsafeSlice i n v- basicOverlaps (MGeoV v1) (MGeoV v2) = GVM.basicOverlaps v1 v2-- basicUnsafeRead (MGeoV v) i = do (x,y) <- GVM.basicUnsafeRead v i- return $ Geo (Latitude x) $ Longitude y- basicUnsafeWrite (MGeoV v) i (Geo x y) = GVM.basicUnsafeWrite v i (unLat x, unLong y)-- basicClear (MGeoV v) = GVM.basicClear v- basicSet (MGeoV v) (Geo x y) = GVM.basicSet v (unLat x, unLong y)-- basicUnsafeNew n = MGeoV `liftM` GVM.basicUnsafeNew n- basicUnsafeReplicate n (Geo x y) = MGeoV `liftM` GVM.basicUnsafeReplicate n (unLat x, unLong y)- basicUnsafeCopy (MGeoV v1) (MGeoV v2) = GVM.basicUnsafeCopy v1 v2- basicUnsafeGrow (MGeoV v) n = MGeoV `liftM` GVM.basicUnsafeGrow v n--#if MIN_VERSION_vector(0,11,0)- basicInitialize (MGeoV v) = GVM.basicInitialize v-#endif--instance GV.Vector Vector Geo where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MGeoV v) = GeoV `liftM` GV.basicUnsafeFreeze v- basicUnsafeThaw (GeoV v) = MGeoV `liftM` GV.basicUnsafeThaw v- basicLength (GeoV v) = GV.basicLength v- basicUnsafeSlice i n (GeoV v) = GeoV $ GV.basicUnsafeSlice i n v- basicUnsafeIndexM (GeoV v) i =do (x,y) <- GV.basicUnsafeIndexM v i- return $ Geo (Latitude x) $ Longitude y-- basicUnsafeCopy (MGeoV mv) (GeoV v) = GV.basicUnsafeCopy mv v- elemseq _ (Geo x y) = GV.elemseq (undefined :: Vector a) (unLat x, unLong y)
− Naqsha/Geometry/Coordinate/GeoHash.hs
@@ -1,214 +0,0 @@--- | This module implements the geohash encoding of geo-locations.--- https://en.wikipedia.org/wiki/Geohash. To try out geohash encoding--- on web visit http://geohash.org--module Naqsha.Geometry.Coordinate.GeoHash- ( GeoHash, encode, decode, accuracy, toByteString- ) where---import Data.Bits-import qualified Data.ByteString as B-import Data.ByteString.Internal ( c2w, w2c )-import Data.Char ( ord )-import Data.String-import Data.Monoid ( (<>) )-import Data.Word ( Word8 )----import Naqsha.Geometry.Internal-import Naqsha.Geometry.Coordinate ( Geo(..) )------ | Precision of encoding measured in base32 digits.-accuracyBase32 :: Int-accuracyBase32 = 12---- | Precision of encoding measured in bits.-accuracy :: Int-accuracy = accuracyBase32 * 5---- | The length of the output.-outputLength :: Int-outputLength = 2 * accuracyBase32---- | The encoding of geo-coordinates as a geohash string. Currently,--- the encoding supports 24 base32 digits of geo hash value which--- means we loose about 4-bits of accuracy w.r.t the representation of--- angles in the library. However, this loss is rather theoretical as--- the angular error that results from such loss is so insignificant--- that for all practical purposes, this accuracy is good enough ------ GPS devices will have much greater errors. The quantity `accuracy`--- gives the number of bits of precision supported by the geohash--- implementation exposed here. As expected GeoHash implementations--- here will have problems at regions close to the poles.-newtype GeoHash = GeoHash B.ByteString deriving (Eq, Ord)--instance Show GeoHash where- show (GeoHash x) = map b32ToChar $ B.unpack x--instance IsString GeoHash where- fromString = GeoHash . B.pack . map cToB32 . take 24-------------------------------------------- Base 32 encoding used by geohash ------------------------------ The digit ranges are--- 0-9, b-h, jk, mn, p-z------ b - 10--- c - 11--- d - 12--- e - 13--- f - 14--- g - 15--- h - 16---------- Broken range ------ j - 17--- k - 18---------- Broken range ------- m - 19--- n - 20----------- Broken range ------ p - 21--- q - 22--- r - 23--- s - 24--- t - 25--- u - 26--- v - 27--- w - 28--- x - 29--- y - 30--- x - 31--cToB32 :: Char -> Word8-cToB32 x- | '0' <= x && x <= '9' = toEnum $ ord x - ord '0'- | 'b' <= x && x <= 'h' = toEnum $ ord x - ord 'b' + 10- | 'p' <= x && x <= 'z' = toEnum $ ord x - ord 'p' + 21- | x == 'j' = 17- | x == 'k' = 18- | x == 'm' = 19- | x == 'n' = 20- | otherwise = error $ "geohash: bad character " ++ show x--b32ToChar8 :: Word8 -> Word8-b32ToChar8 b32- | 0 <= w && w <= 9 = c2w '0' + w- | 10 <= w && w <= 16 = c2w 'b' + w - 10- | 21 <= w && w <= 32 = c2w 'p' + w - 21- | w == 17 = c2w 'j'- | w == 18 = c2w 'k'- | w == 19 = c2w 'm'- | w == 20 = c2w 'n'- | otherwise = error "geohash: fatal this should never happen"- where w = b32 .&. 0x1F--b32ToChar :: Word8 -> Char-b32ToChar = w2c . b32ToChar8---- Geohash encoding--- --------------------- Notice that the bits of the geohash encoding is essentially got by--- iterleaving the bits of the longitude and the latitude. However,--- the first bit is 0 for negative angles 1 for positive--- angles. Therefore we need to complement the sign bit. Since--- longitudes vary over the entire range of angles, this is all we--- need to do for adjustment before interleaving the bits.------ However, the latitudes like in the range -90 to +90. If we ignore the--- +90 angle then we have the following property of its bit pattern------ 1. Every positive angle (other than +90) is of the form 00xxxxxxx.------ 2. Every negative angle is of the form 11xxxxxxx.------ Therefore, to get the actual bits that need to be interleaved, we--- need to shift left the bits left by 1 and complement the--- bit. During decoding, we need to do the reverse, i.e. complement--- the bit and shift right by 1 with sign extension.------ For the +90 case while encoding we treat the bit stream as all 1's.--- While decoding we will never get an angle of 90 but can be pretty--- close.---- | Adjust the latitude for encoding.-adjustEncodeLat :: Latitude -> Angle-adjustEncodeLat lt- | testBit lt 63 = clearBit a 63 -- negative angle (starting bit = 0)- | testBit a 63 = complement zeroBits -- +90- | otherwise = setBit a 63 -- positive angle (starting bit = 1)- where a = unsafeShiftL (unLat lt) 1---- | Adjust the angle while decoding.-adjustDecodeLat :: Angle -> Latitude-adjustDecodeLat a = sgnBit .|. unsafeShiftR lt 1- where lt = Latitude $ complementBit a 63- sgnBit = bit 63 .&. lt---- | Adjusting longitude while encoding. Just nee-adjustEncodeLon :: Longitude -> Angle-adjustEncodeLon = flip complementBit 63 . unLong---- | Adjusting longitude while decoding-adjustDecodeLon :: Angle -> Longitude-adjustDecodeLon = Longitude . flip complementBit 63----- | Convert the geo hash to bytestring.-toByteString :: GeoHash -> B.ByteString-toByteString (GeoHash x) = B.map b32ToChar8 x----------------- Interleaved base32 encoding ---------- | The @interleaveAndMerge (x,y)@ merges 5-bits, 3 from @x@ and 2--- from @y@ into a word and returns it. An appropriate swap is done so--- that the next bytes are taken from y and x respectively.-interleaveAndMerge :: (Angle, Angle) -> (Word8, (Angle, Angle))-interleaveAndMerge (x,y) = (w, (yp, xp))- where xp = rotateL x 3 -- Take the top 3 bits- yp = rotateL y 2 -- Take the top 2 bits- wx = fromIntegral $ unAngle xp- wy = fromIntegral $ unAngle yp- w = unsafeShiftL (wx .&. 4) 2 -- x2 -> w4- .|. unsafeShiftL (wx .&. 2) 1 -- x1 -> w2- .|. (wx .&. 1) -- x0 -> w0- .|. unsafeShiftL (wy .&. 2) 2 -- y1 -> w3- .|. unsafeShiftL (wy .&. 1) 1 -- y0 -> w1----- | Encode a geo-location into its GeoHash string.-encode :: Geo -> GeoHash-encode (Geo lt lng) = GeoHash $ fst $ B.unfoldrN outputLength fld (adjustEncodeLon lng , adjustEncodeLat lt)- where fld = Just . interleaveAndMerge---------------------------- Decoding ------------------------------------ | This function distributes the bits of the Word8 argument--- (actually only 5-bits matter) to x and y in an interleaved fashion.--- x gets 3-bits and y gets 2. The arguments are switched so that for--- the next byte is distributed to y and x respectively.-splitAndDistribute :: (Angle, Angle) -> Word8 -> (Angle , Angle)-splitAndDistribute (x,y) w = (yp,xp)- where xp = unsafeShiftL x 3- .|. (4 `bitTo` 2)- .|. (2 `bitTo` 1)- .|. (0 `bitTo` 0)- yp = unsafeShiftL y 2- .|. (3 `bitTo` 1)- .|. (1 `bitTo` 0)- bitTo i j = Angle $ fromIntegral $ unsafeShiftL (unsafeShiftR w i .&. 1) j----- | Decode the geo-location from its GeoHash string.-decode :: GeoHash -> Geo-decode (GeoHash hsh) = Geo lt ln- where lt = adjustDecodeLat $ unsafeShiftL y 4- ln = adjustDecodeLon $ unsafeShiftL x 4- (x,y) = B.foldl splitAndDistribute (Angle 0,Angle 0) strP- hshLen = B.length hsh- strP = if hshLen > outputLength then B.take outputLength hsh- else hsh <> B.replicate (outputLength - hshLen) 0
− Naqsha/Geometry/Internal.hs
@@ -1,311 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}---- | The internal module that exposes the basic geometric types in--- naqsha. This interface is subject to change and hence use with--- caution.-module Naqsha.Geometry.Internal- ( Angle(..)- , degree , minute, second- , radian- , toDegree, toRadian- , Latitude(..), Longitude(..), lat, lon- ) where---- Ugly hack to prevent pre-7.10 ghc warnings--import Control.Applicative ( (<$>) )-import Control.Monad ( liftM )-import Data.Bits ( Bits )-import Data.Fixed-import Data.Group-import Data.Monoid-import Data.Int-import GHC.Real-import Data.Vector.Unboxed ( MVector(..), Vector, Unbox)-import qualified Data.Vector.Generic as GV-import qualified Data.Vector.Generic.Mutable as GVM-import Text.Read------------------------------- Angles and Angular quantities --------------------------- | An abstract angle. Internally, angles are represented as a 64-bit--- integer with each unit contribute 1/2^64 fraction of a complete--- circle. This means that angles are accurate up to a resolution of 2--- π / 2^64 radians. Angles form a group under the angular addition--- and the fact that these are represented as integers means one can--- expect high speed accurate angle arithmetic.------ When expressing angles one can use a more convenient notation:------ > myAngle = degree 21.71167--- > yourAngle = degree 21 <> minute 42 <> second 42----newtype Angle = Angle {unAngle :: Int64} deriving (Enum, Eq, Ord, Unbox, Show, Read, Bits)--instance Monoid Angle where- mempty = Angle 0- mappend (Angle x) (Angle y) = Angle $ x + y- mconcat = Angle . sum . map unAngle--instance Group Angle where- invert (Angle x) = Angle $ negate x--instance Bounded Angle where- maxBound = Angle maxBound- minBound = Angle minBound---- | Express angle in degrees.-degree :: Rational -> Angle-degree = Angle . fromInteger . round . (*scale)- where scale = (2^(64:: Int)) % 360---- | Express angle in minutes.-minute :: Rational -> Angle-minute = degree . (*scale)- where scale = 1 % 60---- | Express angle in seconds.-second :: Rational -> Angle-second = degree . (*scale)- where scale = 1 % 3600---- | Express angle in radians-radian :: Double -> Angle-radian = Angle . round . (*scale)- where scale = (2^(63:: Int)) / pi------------------------- Decimal representation of angle -------------------------------------- | Measure angle in degrees. This conversion may lead to loss of--- precision.-toDegree :: Fractional r => Angle -> r-toDegree = fromRational . (*conv) . toRational . unAngle- where conv = 360 % (2^(64 :: Int))---- | Measure angle in radians. This conversion may lead to loss of--- precision.-toRadian :: Angle -> Double-toRadian = (*conv) . fromIntegral . unAngle- where conv = pi / (2^(63:: Int))--------------------- Making stuff suitable for unboxed vector. ----------------------------newtype instance MVector s Angle = MAngV (MVector s Int64)-newtype instance Vector Angle = AngV (Vector Int64)---instance GVM.MVector MVector Angle where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MAngV v) = GVM.basicLength v- basicUnsafeSlice i n (MAngV v) = MAngV $ GVM.basicUnsafeSlice i n v- basicOverlaps (MAngV v1) (MAngV v2) = GVM.basicOverlaps v1 v2-- basicUnsafeRead (MAngV v) i = Angle `liftM` GVM.basicUnsafeRead v i- basicUnsafeWrite (MAngV v) i (Angle x) = GVM.basicUnsafeWrite v i x-- basicClear (MAngV v) = GVM.basicClear v- basicSet (MAngV v) (Angle x) = GVM.basicSet v x-- basicUnsafeNew n = MAngV `liftM` GVM.basicUnsafeNew n- basicUnsafeReplicate n (Angle x) = MAngV `liftM` GVM.basicUnsafeReplicate n x- basicUnsafeCopy (MAngV v1) (MAngV v2) = GVM.basicUnsafeCopy v1 v2- basicUnsafeGrow (MAngV v) n = MAngV `liftM` GVM.basicUnsafeGrow v n--#if MIN_VERSION_vector(0,11,0)- basicInitialize (MAngV v) = GVM.basicInitialize v-#endif--instance GV.Vector Vector Angle where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MAngV v) = AngV `liftM` GV.basicUnsafeFreeze v- basicUnsafeThaw (AngV v) = MAngV `liftM` GV.basicUnsafeThaw v- basicLength (AngV v) = GV.basicLength v- basicUnsafeSlice i n (AngV v) = AngV $ GV.basicUnsafeSlice i n v- basicUnsafeIndexM (AngV v) i = Angle `liftM` GV.basicUnsafeIndexM v i-- basicUnsafeCopy (MAngV mv) (AngV v) = GV.basicUnsafeCopy mv v- elemseq _ (Angle x) = GV.elemseq (undefined :: Vector a) x--------------------------------------- Latitude and Longitude -------------------------------------- | The latitude of a point. Positive denotes North of Equator where--- as negative South.-newtype Latitude = Latitude { unLat :: Angle } deriving (Eq, Ord, Bits)---instance Show Latitude where- show = show . (toDegree :: Angle -> Nano) . unLat--instance Read Latitude where- readPrec = conv <$> readPrec- where conv = lat . degree . (toRational :: Nano -> Rational)--instance Bounded Latitude where- maxBound = lat $ degree 90- minBound = lat $ degree (-90)----- | Construct latitude out of an angle.-lat :: Angle -> Latitude-lat = Latitude . normLat----- | normalise latitude values.-normLat :: Angle -> Angle-normLat ang | degree (-90) <= ang && ang < degree 90 = ang- | ang > degree 90 = succ (maxBound <> invert ang)- | otherwise = minBound <> invert ang----------------------------- Longitude ---------------------------------------------- | The longitude of a point. Positive denotes East of the Greenwich--- meridian where as negative denotes West.-newtype Longitude = Longitude { unLong :: Angle }- deriving (Eq, Bounded, Ord, Monoid, Group, Bits)---- | Convert angles to longitude.-lon :: Angle -> Longitude-lon = Longitude---instance Show Longitude where- show = show . (toDegree :: Angle -> Nano) . unLong--instance Read Longitude where- readPrec = conv <$> readPrec- where conv = lon . degree . (toRational :: Nano -> Rational)------------------------------ Internal helper functions ---------------------------newtype instance MVector s Latitude = MLatV (MVector s Angle)-newtype instance Vector Latitude = LatV (Vector Angle)---newtype instance MVector s Longitude = MLongV (MVector s Angle)-newtype instance Vector Longitude = LongV (Vector Angle)----------------------- Instance for Angle ------------------------------------------------------------------- Instance for latitude ----------------------------------------------instance GVM.MVector MVector Latitude where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MLatV v) = GVM.basicLength v- basicUnsafeSlice i n (MLatV v) = MLatV $ GVM.basicUnsafeSlice i n v- basicOverlaps (MLatV v1) (MLatV v2) = GVM.basicOverlaps v1 v2-- basicUnsafeRead (MLatV v) i = Latitude `liftM` GVM.basicUnsafeRead v i- basicUnsafeWrite (MLatV v) i (Latitude x) = GVM.basicUnsafeWrite v i x-- basicClear (MLatV v) = GVM.basicClear v- basicSet (MLatV v) (Latitude x) = GVM.basicSet v x-- basicUnsafeNew n = MLatV `liftM` GVM.basicUnsafeNew n- basicUnsafeReplicate n (Latitude x) = MLatV `liftM` GVM.basicUnsafeReplicate n x- basicUnsafeCopy (MLatV v1) (MLatV v2) = GVM.basicUnsafeCopy v1 v2- basicUnsafeGrow (MLatV v) n = MLatV `liftM` GVM.basicUnsafeGrow v n--#if MIN_VERSION_vector(0,11,0)- basicInitialize (MLatV v) = GVM.basicInitialize v-#endif--instance GV.Vector Vector Latitude where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MLatV v) = LatV `liftM` GV.basicUnsafeFreeze v- basicUnsafeThaw (LatV v) = MLatV `liftM` GV.basicUnsafeThaw v- basicLength (LatV v) = GV.basicLength v- basicUnsafeSlice i n (LatV v) = LatV $ GV.basicUnsafeSlice i n v- basicUnsafeIndexM (LatV v) i = Latitude `liftM` GV.basicUnsafeIndexM v i-- basicUnsafeCopy (MLatV mv) (LatV v) = GV.basicUnsafeCopy mv v- elemseq _ (Latitude x) = GV.elemseq (undefined :: Vector a) x----------------------------------- Instance for Longitude -------------------------------------instance GVM.MVector MVector Longitude where- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicOverlaps #-}- {-# INLINE basicUnsafeNew #-}- {-# INLINE basicUnsafeReplicate #-}- {-# INLINE basicUnsafeRead #-}- {-# INLINE basicUnsafeWrite #-}- {-# INLINE basicClear #-}- {-# INLINE basicSet #-}- {-# INLINE basicUnsafeCopy #-}- {-# INLINE basicUnsafeGrow #-}- basicLength (MLongV v) = GVM.basicLength v- basicUnsafeSlice i n (MLongV v) = MLongV $ GVM.basicUnsafeSlice i n v- basicOverlaps (MLongV v1) (MLongV v2) = GVM.basicOverlaps v1 v2-- basicUnsafeRead (MLongV v) i = Longitude `liftM` GVM.basicUnsafeRead v i- basicUnsafeWrite (MLongV v) i (Longitude x) = GVM.basicUnsafeWrite v i x-- basicClear (MLongV v) = GVM.basicClear v- basicSet (MLongV v) (Longitude x) = GVM.basicSet v x-- basicUnsafeNew n = MLongV `liftM` GVM.basicUnsafeNew n- basicUnsafeReplicate n (Longitude x) = MLongV `liftM` GVM.basicUnsafeReplicate n x- basicUnsafeCopy (MLongV v1) (MLongV v2) = GVM.basicUnsafeCopy v1 v2- basicUnsafeGrow (MLongV v) n = MLongV `liftM` GVM.basicUnsafeGrow v n--#if MIN_VERSION_vector(0,11,0)- basicInitialize (MLongV v) = GVM.basicInitialize v-#endif--instance GV.Vector Vector Longitude where- {-# INLINE basicUnsafeFreeze #-}- {-# INLINE basicUnsafeThaw #-}- {-# INLINE basicLength #-}- {-# INLINE basicUnsafeSlice #-}- {-# INLINE basicUnsafeIndexM #-}- {-# INLINE elemseq #-}- basicUnsafeFreeze (MLongV v) = LongV `liftM` GV.basicUnsafeFreeze v- basicUnsafeThaw (LongV v) = MLongV `liftM` GV.basicUnsafeThaw v- basicLength (LongV v) = GV.basicLength v- basicUnsafeSlice i n (LongV v) = LongV $ GV.basicUnsafeSlice i n v- basicUnsafeIndexM (LongV v) i = Longitude `liftM` GV.basicUnsafeIndexM v i-- basicUnsafeCopy (MLongV mv) (LongV v) = GV.basicUnsafeCopy mv v- elemseq _ (Longitude x) = GV.elemseq (undefined :: Vector a) x
− Naqsha/Geometry/Spherical.hs
@@ -1,67 +0,0 @@--- | Geometric operations on earth surface assuming that earth is a--- sphere of radius 6371008 m.------ TODO: Port some calculations from--- http://www.movable-type.co.uk/scripts/latlong.html----module Naqsha.Geometry.Spherical- (- -- * Distance calculation.- distance, distance'- , rMean- ) where--import Data.Monoid-import Data.Group-import Naqsha.Geometry.Coordinate-import Naqsha.Geometry.Angle----------------------- Distance calculation ----------------------------------------- | Mean earth radius in meters. This is the radius used in the--- haversine formula of `dHvs`.-rMean :: Double-rMean = 6371008----- | This combinator computes the distance (in meters) between two--- geo-locations using the haversine distance between two points. For--- `Position` which have an-distance :: Geo- -> Geo- -> Double -- ^ Distance in meters.-distance = distance' rMean----- | A generalisation of `distance` that takes the radius as--- argument. Will work on Mars for example once we set up a latitude--- longitude system there. For this function units does not matter ------ the computed distance is in the same unit as the input radius. We--- have------ > distance = distance' rMean----distance' :: Double -- ^ Radius (in whatever unit)- -> Geo- -> Geo- -> Double--distance' r (Geo lat1 lon1) (Geo lat2 lon2) = r * c- where p1 = toAngle lat1- l1 = toAngle lon1- p2 = toAngle lat2- l2 = toAngle lon2- dp = p2 <> invert p1- dl = l2 <> invert l1-- phi1 = toRadian p1- phi2 = toRadian p2-- a = hav dp + cos phi1 * cos phi2 * hav dl- c = 2 * atan2 (sqrt a) (sqrt (1 - a))---- | The haversine functions.-hav :: Angle -> Double-{-# INLINE hav #-}-hav theta = stheta * stheta- where stheta = sin (toRadian theta/2.0)
− Naqsha/Version.hs
@@ -1,16 +0,0 @@--- | Naqsha library version.-module Naqsha.Version- ( version- , versionString- ) where--import Data.Version-import qualified Paths_naqsha as NP---- | The version string associated with naqsha.-versionString :: String-versionString = "naqsha-" ++ showVersion version---- | The naqsha library version-version :: Version-version = NP.version
README.md view
@@ -20,6 +20,28 @@ The word naqsha, or more accurately naqshA (नक़्शा), means a map or a sketch. +# Legal++Copyright 2016 Piyush P Kurur++The library is licensed under++* Apache License, Version 2.0+ <http://www.apache.org/licenses/LICENSE-2.0>+* BSD 3-Clause license+ <https://opensource.org/licenses/BSD-3-Clause>++You may not use this software except in compliance with one of the+above Licenses (*at your option*).++SPDX-License-Identifier: (Apache-2.0 OR BSD-3-Clause)++Unless required by applicable law or agreed to in writing, software+distributed under these Licenses is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+implied. For the exact terms and conditions see the accompanying+LICENSE file.+ [travis-status]: <https://secure.travis-ci.org/naqsha/naqsha.png> "Build status" [travis-naqsha]: <https://travis-ci.org/naqsha/naqsha>
+ geospatial/Naqsha/Geometry.hs view
@@ -0,0 +1,63 @@+-- | The geometric types and values exposed by naqsha.+module Naqsha.Geometry+ ( module Naqsha.Geometry.Coordinate++ -- ** Angles and angular quantities.+ , module Naqsha.Geometry.Angle++ -- * Geometric hashing.+ -- $geohashing$++ -- * Distance calculation.+ --+ -- $distance$+ --++ -- * Internal details+ -- $internals$+ ) where++import Naqsha.Geometry.Angle+import Naqsha.Geometry.Coordinate++-- Nothing imported here. Only for docs.+import Naqsha.Geometry.Spherical()+++-- $geohashing$+--+-- Geometric hashing is a technique of converting geometric+-- coordinates into 1-dimension strings. Often these hashes ensures+-- that string with large common prefix are close by (although not the+-- converse). Hence, these hashes can be used to stored geo-cordinates+-- in database and build into it a sense of location awareness. We support+-- the following geometric hashing:+--+-- ["Naqsha.Geometry.Coordinate.GeoHash":] The geohash standard+-- (<https://en.wikipedia.org/wiki/Geohash>).+--+-- None of these modules are imported by default the user may import+-- the one that is most desirable.++-- $distance$+--+-- Calculating quantities like distance, bearing etc depends on the+-- model of the globe that we choose. Even in a given model we might+-- have different algorithms to compute the distance depending on+-- speed-accuracy trade-offs. Choosing the correct model and+-- algorithms is application dependent and hence we do not expose any+-- default ones. The following modules can be imported depending on the need+--+-- ["Naqsha.Geometry.Spherical": ] Assume a spherical model of the+-- globe. Distance is calculated using the haversine formula.+++-- $internals$+--+-- The basic types like `Latitude` or `Longitude` are exposed as+-- opaque types from this module. This gives a certain amount of type+-- safety when working with these quantities. A user should, whenever+-- possible, only use this module. For the rare case when some+-- non-trivial operations need to be defined, we expose the internal+-- module "Naqsha.Geometry.Internal". However, use this interface with+-- caution.
+ geospatial/Naqsha/Geometry/Angle.hs view
@@ -0,0 +1,26 @@+-- | Basic types associated with geometry.+module Naqsha.Geometry.Angle+ ( Angle+ , degree , minute, second+ , radian+ , toDegree, toRadian+ , Angular(..)+ ) where++import Naqsha.Geometry.Internal++------------------------------ The angular class ------------------------++-- | Angular quantities.+class Angular a where+ toAngle :: a -> Angle++instance Angular Angle where+ toAngle = id+++instance Angular Latitude where+ toAngle = unLat++instance Angular Longitude where+ toAngle = unLong
+ geospatial/Naqsha/Geometry/Coordinate.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+-- | This module captures position of a point on the globe.+module Naqsha.Geometry.Coordinate+ ( -- * Basics+ -- $latandlong$+ Geo(..)+ , northPole, southPole+ -- ** Latitudes+ , Latitude+ , lat, north, south+ , equator+ , tropicOfCancer+ , tropicOfCapricon+ -- ** Longitudes.+ , Longitude+ , lon, east, west+ , greenwich+ ) where++import Control.Monad ( liftM )+import Data.Group+import Data.Vector.Unboxed ( MVector(..), Vector)+import qualified Data.Vector.Generic as GV+import qualified Data.Vector.Generic.Mutable as GVM+++import Prelude -- To avoid redundunt import warnings.++import Naqsha.Geometry.Angle+import Naqsha.Geometry.Internal++++-- $latandlong$+--+-- A point on the globe is specified by giving its geo coordinates+-- represented by the type `Geo`. It is essentially a pair of the+-- `Latitude` and `Longitude` of the point.+--+-- == Examples+--+-- > kanpurLatitude :: Latitude+-- > kanpurLatitude = lat $ degree 26.4477777+-- > kanpurLongitude :: Longitude+-- > kanpurLongitude = lon $ degree 80.3461111+-- > kanpurGeo :: Geo+-- > kanpurGeo = Geo kanpurLatitude kanpurLongitude+--+-- You can also specify the latitude and longitude in units of degree,+-- minute and seconds.+--+-- > kanpurLatitude = lat $ degree 26 <> minute 26 <> second 52+-- > kanpurLongitude = lon $ degree 80 <> minute 20 <> second 46+--+-- The show and read instance of the `Latitude` and `Longitude` types+-- uses degrees for displaying and reading respectively. Show and Read+-- instances can express these quantities up to Nano degree precision.+--+-- == Convention on sign.+--+-- For latitudes, positive means north of the equator and negative+-- means south. In the case of longitudes, positive means east of the+-- longitude zero and negative means west. However, if you find these+-- conventions confusing you can use the combinators `north`, `south`,+-- `east`, and `west` when constructing latitudes or longitudes.+--+++-- | Convert an angle to a northern latitude+--+-- > tropicOfCancer = north $ degree 23.5+--+north :: Angle -> Latitude+north = lat++-- | Convert an angle to a southern latitude.+--+-- > tropicOfCapricon = south $ degree 23.5+--+south :: Angle -> Latitude+south = lat . invert+++-- | The latitude of equator.+equator :: Latitude+equator = lat $ degree 0++-- | The latitude corresponding to the Tropic of Cancer.+tropicOfCancer :: Latitude+tropicOfCancer = north $ degree 23.5++-- | The latitude corresponding to the Tropic of Capricon+tropicOfCapricon :: Latitude+tropicOfCapricon = south $ degree 23.5++-- | Convert angle to an eastern longitude.+--+-- > kanpurLongitude = east $ degree 80.3461+--+east :: Angle -> Longitude+east = lon++-- | Convert angle to a western longitude+--+-- > newyorkLongitude = west $ degree 74.0059+--+west :: Angle -> Longitude+west = lon . invert+++-- | The zero longitude.+greenwich :: Longitude+greenwich = lon $ degree 0+++------------------- The geometric coordinates. -----------------++-- | The coordinates of a point on the earth's surface.+data Geo = Geo {-# UNPACK #-} !Latitude+ {-# UNPACK #-} !Longitude+ deriving Show+++-- | The North pole+northPole :: Geo+northPole = Geo maxBound $ lon $ degree 0++-- | The South pole+southPole :: Geo+southPole = Geo minBound $ lon $ degree 0++instance Eq Geo where+ (==) (Geo xlat xlong) (Geo ylat ylong)+ | xlat == maxBound = ylat == maxBound -- longitude irrelevant for north pole+ | xlat == minBound = ylat == minBound -- longitude irrelevant for south pole+ | otherwise = xlat == ylat && xlong == ylong++----------------------------- Vector Instance for Geo ---------------------------------------------+++newtype instance MVector s Geo = MGeoV (MVector s (Angle,Angle))+newtype instance Vector Geo = GeoV (Vector (Angle,Angle))+++instance GVM.MVector MVector Geo where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MGeoV v) = GVM.basicLength v+ basicUnsafeSlice i n (MGeoV v) = MGeoV $ GVM.basicUnsafeSlice i n v+ basicOverlaps (MGeoV v1) (MGeoV v2) = GVM.basicOverlaps v1 v2++ basicUnsafeRead (MGeoV v) i = do (x,y) <- GVM.basicUnsafeRead v i+ return $ Geo (Latitude x) $ Longitude y+ basicUnsafeWrite (MGeoV v) i (Geo x y) = GVM.basicUnsafeWrite v i (unLat x, unLong y)++ basicClear (MGeoV v) = GVM.basicClear v+ basicSet (MGeoV v) (Geo x y) = GVM.basicSet v (unLat x, unLong y)++ basicUnsafeNew n = MGeoV `liftM` GVM.basicUnsafeNew n+ basicUnsafeReplicate n (Geo x y) = MGeoV `liftM` GVM.basicUnsafeReplicate n (unLat x, unLong y)+ basicUnsafeCopy (MGeoV v1) (MGeoV v2) = GVM.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MGeoV v) n = MGeoV `liftM` GVM.basicUnsafeGrow v n++#if MIN_VERSION_vector(0,11,0)+ basicInitialize (MGeoV v) = GVM.basicInitialize v+#endif++instance GV.Vector Vector Geo where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MGeoV v) = GeoV `liftM` GV.basicUnsafeFreeze v+ basicUnsafeThaw (GeoV v) = MGeoV `liftM` GV.basicUnsafeThaw v+ basicLength (GeoV v) = GV.basicLength v+ basicUnsafeSlice i n (GeoV v) = GeoV $ GV.basicUnsafeSlice i n v+ basicUnsafeIndexM (GeoV v) i =do (x,y) <- GV.basicUnsafeIndexM v i+ return $ Geo (Latitude x) $ Longitude y++ basicUnsafeCopy (MGeoV mv) (GeoV v) = GV.basicUnsafeCopy mv v+ elemseq _ (Geo x y) = GV.elemseq (undefined :: Vector a) (unLat x, unLong y)
+ geospatial/Naqsha/Geometry/Coordinate/GeoHash.hs view
@@ -0,0 +1,214 @@+-- | This module implements the geohash encoding of geo-locations.+-- https://en.wikipedia.org/wiki/Geohash. To try out geohash encoding+-- on web visit http://geohash.org++module Naqsha.Geometry.Coordinate.GeoHash+ ( GeoHash, encode, decode, accuracy, toByteString+ ) where+++import Data.Bits+import qualified Data.ByteString as B+import Data.ByteString.Internal ( c2w, w2c )+import Data.Char ( ord )+import Data.String+import Data.Monoid ( (<>) )+import Data.Word ( Word8 )++++import Naqsha.Geometry.Internal+import Naqsha.Geometry.Coordinate ( Geo(..) )++++-- | Precision of encoding measured in base32 digits.+accuracyBase32 :: Int+accuracyBase32 = 12++-- | Precision of encoding measured in bits.+accuracy :: Int+accuracy = accuracyBase32 * 5++-- | The length of the output.+outputLength :: Int+outputLength = 2 * accuracyBase32++-- | The encoding of geo-coordinates as a geohash string. Currently,+-- the encoding supports 24 base32 digits of geo hash value which+-- means we loose about 4-bits of accuracy w.r.t the representation of+-- angles in the library. However, this loss is rather theoretical as+-- the angular error that results from such loss is so insignificant+-- that for all practical purposes, this accuracy is good enough ---+-- GPS devices will have much greater errors. The quantity `accuracy`+-- gives the number of bits of precision supported by the geohash+-- implementation exposed here. As expected GeoHash implementations+-- here will have problems at regions close to the poles.+newtype GeoHash = GeoHash B.ByteString deriving (Eq, Ord)++instance Show GeoHash where+ show (GeoHash x) = map b32ToChar $ B.unpack x++instance IsString GeoHash where+ fromString = GeoHash . B.pack . map cToB32 . take 24++------------------------------------------ Base 32 encoding used by geohash --------------------------++-- The digit ranges are+-- 0-9, b-h, jk, mn, p-z+--+-- b - 10+-- c - 11+-- d - 12+-- e - 13+-- f - 14+-- g - 15+-- h - 16+--------- Broken range ---+-- j - 17+-- k - 18+--------- Broken range ----+-- m - 19+-- n - 20+---------- Broken range ---+-- p - 21+-- q - 22+-- r - 23+-- s - 24+-- t - 25+-- u - 26+-- v - 27+-- w - 28+-- x - 29+-- y - 30+-- x - 31++cToB32 :: Char -> Word8+cToB32 x+ | '0' <= x && x <= '9' = toEnum $ ord x - ord '0'+ | 'b' <= x && x <= 'h' = toEnum $ ord x - ord 'b' + 10+ | 'p' <= x && x <= 'z' = toEnum $ ord x - ord 'p' + 21+ | x == 'j' = 17+ | x == 'k' = 18+ | x == 'm' = 19+ | x == 'n' = 20+ | otherwise = error $ "geohash: bad character " ++ show x++b32ToChar8 :: Word8 -> Word8+b32ToChar8 b32+ | 0 <= w && w <= 9 = c2w '0' + w+ | 10 <= w && w <= 16 = c2w 'b' + w - 10+ | 21 <= w && w <= 32 = c2w 'p' + w - 21+ | w == 17 = c2w 'j'+ | w == 18 = c2w 'k'+ | w == 19 = c2w 'm'+ | w == 20 = c2w 'n'+ | otherwise = error "geohash: fatal this should never happen"+ where w = b32 .&. 0x1F++b32ToChar :: Word8 -> Char+b32ToChar = w2c . b32ToChar8++-- Geohash encoding+-- ---------------+--+-- Notice that the bits of the geohash encoding is essentially got by+-- iterleaving the bits of the longitude and the latitude. However,+-- the first bit is 0 for negative angles 1 for positive+-- angles. Therefore we need to complement the sign bit. Since+-- longitudes vary over the entire range of angles, this is all we+-- need to do for adjustment before interleaving the bits.+--+-- However, the latitudes like in the range -90 to +90. If we ignore the+-- +90 angle then we have the following property of its bit pattern+--+-- 1. Every positive angle (other than +90) is of the form 00xxxxxxx.+--+-- 2. Every negative angle is of the form 11xxxxxxx.+--+-- Therefore, to get the actual bits that need to be interleaved, we+-- need to shift left the bits left by 1 and complement the+-- bit. During decoding, we need to do the reverse, i.e. complement+-- the bit and shift right by 1 with sign extension.+--+-- For the +90 case while encoding we treat the bit stream as all 1's.+-- While decoding we will never get an angle of 90 but can be pretty+-- close.++-- | Adjust the latitude for encoding.+adjustEncodeLat :: Latitude -> Angle+adjustEncodeLat lt+ | testBit lt 63 = clearBit a 63 -- negative angle (starting bit = 0)+ | testBit a 63 = complement zeroBits -- +90+ | otherwise = setBit a 63 -- positive angle (starting bit = 1)+ where a = unsafeShiftL (unLat lt) 1++-- | Adjust the angle while decoding.+adjustDecodeLat :: Angle -> Latitude+adjustDecodeLat a = sgnBit .|. unsafeShiftR lt 1+ where lt = Latitude $ complementBit a 63+ sgnBit = bit 63 .&. lt++-- | Adjusting longitude while encoding. Just nee+adjustEncodeLon :: Longitude -> Angle+adjustEncodeLon = flip complementBit 63 . unLong++-- | Adjusting longitude while decoding+adjustDecodeLon :: Angle -> Longitude+adjustDecodeLon = Longitude . flip complementBit 63+++-- | Convert the geo hash to bytestring.+toByteString :: GeoHash -> B.ByteString+toByteString (GeoHash x) = B.map b32ToChar8 x++--------------- Interleaved base32 encoding ------++-- | The @interleaveAndMerge (x,y)@ merges 5-bits, 3 from @x@ and 2+-- from @y@ into a word and returns it. An appropriate swap is done so+-- that the next bytes are taken from y and x respectively.+interleaveAndMerge :: (Angle, Angle) -> (Word8, (Angle, Angle))+interleaveAndMerge (x,y) = (w, (yp, xp))+ where xp = rotateL x 3 -- Take the top 3 bits+ yp = rotateL y 2 -- Take the top 2 bits+ wx = fromIntegral $ unAngle xp+ wy = fromIntegral $ unAngle yp+ w = unsafeShiftL (wx .&. 4) 2 -- x2 -> w4+ .|. unsafeShiftL (wx .&. 2) 1 -- x1 -> w2+ .|. (wx .&. 1) -- x0 -> w0+ .|. unsafeShiftL (wy .&. 2) 2 -- y1 -> w3+ .|. unsafeShiftL (wy .&. 1) 1 -- y0 -> w1+++-- | Encode a geo-location into its GeoHash string.+encode :: Geo -> GeoHash+encode (Geo lt lng) = GeoHash $ fst $ B.unfoldrN outputLength fld (adjustEncodeLon lng , adjustEncodeLat lt)+ where fld = Just . interleaveAndMerge++-------------------------- Decoding --------------------------------++-- | This function distributes the bits of the Word8 argument+-- (actually only 5-bits matter) to x and y in an interleaved fashion.+-- x gets 3-bits and y gets 2. The arguments are switched so that for+-- the next byte is distributed to y and x respectively.+splitAndDistribute :: (Angle, Angle) -> Word8 -> (Angle , Angle)+splitAndDistribute (x,y) w = (yp,xp)+ where xp = unsafeShiftL x 3+ .|. (4 `bitTo` 2)+ .|. (2 `bitTo` 1)+ .|. (0 `bitTo` 0)+ yp = unsafeShiftL y 2+ .|. (3 `bitTo` 1)+ .|. (1 `bitTo` 0)+ bitTo i j = Angle $ fromIntegral $ unsafeShiftL (unsafeShiftR w i .&. 1) j+++-- | Decode the geo-location from its GeoHash string.+decode :: GeoHash -> Geo+decode (GeoHash hsh) = Geo lt ln+ where lt = adjustDecodeLat $ unsafeShiftL y 4+ ln = adjustDecodeLon $ unsafeShiftL x 4+ (x,y) = B.foldl splitAndDistribute (Angle 0,Angle 0) strP+ hshLen = B.length hsh+ strP = if hshLen > outputLength then B.take outputLength hsh+ else hsh <> B.replicate (outputLength - hshLen) 0
+ geospatial/Naqsha/Geometry/Internal.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- | The internal module that exposes the basic geometric types in+-- naqsha. This interface is subject to change and hence use with+-- caution.+module Naqsha.Geometry.Internal+ ( Angle(..)+ , degree , minute, second+ , radian+ , toDegree, toRadian+ , Latitude(..), Longitude(..), lat, lon+ ) where++-- Ugly hack to prevent pre-7.10 ghc warnings++import Control.Applicative ( (<$>) )+import Control.Monad ( liftM )+import Data.Bits ( Bits )+import Data.Fixed+import Data.Group+import Data.Int+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid hiding ((<>))+import Data.Semigroup+#endif+import GHC.Real+import Data.Vector.Unboxed ( MVector(..), Vector, Unbox)+import qualified Data.Vector.Generic as GV+import qualified Data.Vector.Generic.Mutable as GVM+import Text.Read++----------------------------- Angles and Angular quantities -----------------------++-- | An abstract angle. Internally, angles are represented as a 64-bit+-- integer with each unit contribute 1/2^64 fraction of a complete+-- circle. This means that angles are accurate up to a resolution of 2+-- π / 2^64 radians. Angles form a group under the angular addition+-- and the fact that these are represented as integers means one can+-- expect high speed accurate angle arithmetic.+--+-- When expressing angles one can use a more convenient notation:+--+-- > myAngle = degree 21.71167+-- > yourAngle = degree 21 <> minute 42 <> second 42+--+newtype Angle = Angle {unAngle :: Int64} deriving (Enum, Eq, Ord, Unbox, Show, Read, Bits)++instance Semigroup Angle where+ (<>) (Angle x) (Angle y) = Angle $ x + y++instance Monoid Angle where+ mempty = Angle 0+ mappend = (<>)+ mconcat = Angle . sum . map unAngle++instance Group Angle where+ invert (Angle x) = Angle $ negate x++instance Bounded Angle where+ maxBound = Angle maxBound+ minBound = Angle minBound++-- | Express angle in degrees.+degree :: Rational -> Angle+degree = Angle . fromInteger . round . (*scale)+ where scale = (2^(64:: Int)) % 360++-- | Express angle in minutes.+minute :: Rational -> Angle+minute = degree . (*scale)+ where scale = 1 % 60++-- | Express angle in seconds.+second :: Rational -> Angle+second = degree . (*scale)+ where scale = 1 % 3600++-- | Express angle in radians+radian :: Double -> Angle+radian = Angle . round . (*scale)+ where scale = (2^(63:: Int)) / pi+++---------------------- Decimal representation of angle ----------------------------------++-- | Measure angle in degrees. This conversion may lead to loss of+-- precision.+toDegree :: Fractional r => Angle -> r+toDegree = fromRational . (*conv) . toRational . unAngle+ where conv = 360 % (2^(64 :: Int))++-- | Measure angle in radians. This conversion may lead to loss of+-- precision.+toRadian :: Angle -> Double+toRadian = (*conv) . fromIntegral . unAngle+ where conv = pi / (2^(63:: Int))++------------------- Making stuff suitable for unboxed vector. --------------------------++newtype instance MVector s Angle = MAngV (MVector s Int64)+newtype instance Vector Angle = AngV (Vector Int64)+++instance GVM.MVector MVector Angle where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MAngV v) = GVM.basicLength v+ basicUnsafeSlice i n (MAngV v) = MAngV $ GVM.basicUnsafeSlice i n v+ basicOverlaps (MAngV v1) (MAngV v2) = GVM.basicOverlaps v1 v2++ basicUnsafeRead (MAngV v) i = Angle `liftM` GVM.basicUnsafeRead v i+ basicUnsafeWrite (MAngV v) i (Angle x) = GVM.basicUnsafeWrite v i x++ basicClear (MAngV v) = GVM.basicClear v+ basicSet (MAngV v) (Angle x) = GVM.basicSet v x++ basicUnsafeNew n = MAngV `liftM` GVM.basicUnsafeNew n+ basicUnsafeReplicate n (Angle x) = MAngV `liftM` GVM.basicUnsafeReplicate n x+ basicUnsafeCopy (MAngV v1) (MAngV v2) = GVM.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MAngV v) n = MAngV `liftM` GVM.basicUnsafeGrow v n++#if MIN_VERSION_vector(0,11,0)+ basicInitialize (MAngV v) = GVM.basicInitialize v+#endif++instance GV.Vector Vector Angle where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MAngV v) = AngV `liftM` GV.basicUnsafeFreeze v+ basicUnsafeThaw (AngV v) = MAngV `liftM` GV.basicUnsafeThaw v+ basicLength (AngV v) = GV.basicLength v+ basicUnsafeSlice i n (AngV v) = AngV $ GV.basicUnsafeSlice i n v+ basicUnsafeIndexM (AngV v) i = Angle `liftM` GV.basicUnsafeIndexM v i++ basicUnsafeCopy (MAngV mv) (AngV v) = GV.basicUnsafeCopy mv v+ elemseq _ (Angle x) = GV.elemseq (undefined :: Vector a) x++------------------------------------- Latitude and Longitude ---------------------------------+++-- | The latitude of a point. Positive denotes North of Equator where+-- as negative South.+newtype Latitude = Latitude { unLat :: Angle } deriving (Eq, Ord, Bits)+++instance Show Latitude where+ show = show . (toDegree :: Angle -> Nano) . unLat++instance Read Latitude where+ readPrec = conv <$> readPrec+ where conv = lat . degree . (toRational :: Nano -> Rational)++instance Bounded Latitude where+ maxBound = lat $ degree 90+ minBound = lat $ degree (-90)+++-- | Construct latitude out of an angle.+lat :: Angle -> Latitude+lat = Latitude . normLat+++-- | normalise latitude values.+normLat :: Angle -> Angle+normLat ang | degree (-90) <= ang && ang < degree 90 = ang+ | ang > degree 90 = succ (maxBound <> invert ang)+ | otherwise = minBound <> invert ang+++-------------------------- Longitude ------------------------------------------++-- | The longitude of a point. Positive denotes East of the Greenwich+-- meridian where as negative denotes West.+newtype Longitude = Longitude { unLong :: Angle }+ deriving (Eq, Bounded, Ord, Semigroup, Monoid, Group, Bits)++-- | Convert angles to longitude.+lon :: Angle -> Longitude+lon = Longitude+++instance Show Longitude where+ show = show . (toDegree :: Angle -> Nano) . unLong++instance Read Longitude where+ readPrec = conv <$> readPrec+ where conv = lon . degree . (toRational :: Nano -> Rational)+++--------------------------- Internal helper functions ------------------------+++newtype instance MVector s Latitude = MLatV (MVector s Angle)+newtype instance Vector Latitude = LatV (Vector Angle)+++newtype instance MVector s Longitude = MLongV (MVector s Angle)+newtype instance Vector Longitude = LongV (Vector Angle)+++-------------------- Instance for Angle --------------------------------------------+++-------------------- Instance for latitude --------------------------------------------++instance GVM.MVector MVector Latitude where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MLatV v) = GVM.basicLength v+ basicUnsafeSlice i n (MLatV v) = MLatV $ GVM.basicUnsafeSlice i n v+ basicOverlaps (MLatV v1) (MLatV v2) = GVM.basicOverlaps v1 v2++ basicUnsafeRead (MLatV v) i = Latitude `liftM` GVM.basicUnsafeRead v i+ basicUnsafeWrite (MLatV v) i (Latitude x) = GVM.basicUnsafeWrite v i x++ basicClear (MLatV v) = GVM.basicClear v+ basicSet (MLatV v) (Latitude x) = GVM.basicSet v x++ basicUnsafeNew n = MLatV `liftM` GVM.basicUnsafeNew n+ basicUnsafeReplicate n (Latitude x) = MLatV `liftM` GVM.basicUnsafeReplicate n x+ basicUnsafeCopy (MLatV v1) (MLatV v2) = GVM.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MLatV v) n = MLatV `liftM` GVM.basicUnsafeGrow v n++#if MIN_VERSION_vector(0,11,0)+ basicInitialize (MLatV v) = GVM.basicInitialize v+#endif++instance GV.Vector Vector Latitude where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MLatV v) = LatV `liftM` GV.basicUnsafeFreeze v+ basicUnsafeThaw (LatV v) = MLatV `liftM` GV.basicUnsafeThaw v+ basicLength (LatV v) = GV.basicLength v+ basicUnsafeSlice i n (LatV v) = LatV $ GV.basicUnsafeSlice i n v+ basicUnsafeIndexM (LatV v) i = Latitude `liftM` GV.basicUnsafeIndexM v i++ basicUnsafeCopy (MLatV mv) (LatV v) = GV.basicUnsafeCopy mv v+ elemseq _ (Latitude x) = GV.elemseq (undefined :: Vector a) x+++-------------------------------- Instance for Longitude -----------------------------------++instance GVM.MVector MVector Longitude where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MLongV v) = GVM.basicLength v+ basicUnsafeSlice i n (MLongV v) = MLongV $ GVM.basicUnsafeSlice i n v+ basicOverlaps (MLongV v1) (MLongV v2) = GVM.basicOverlaps v1 v2++ basicUnsafeRead (MLongV v) i = Longitude `liftM` GVM.basicUnsafeRead v i+ basicUnsafeWrite (MLongV v) i (Longitude x) = GVM.basicUnsafeWrite v i x++ basicClear (MLongV v) = GVM.basicClear v+ basicSet (MLongV v) (Longitude x) = GVM.basicSet v x++ basicUnsafeNew n = MLongV `liftM` GVM.basicUnsafeNew n+ basicUnsafeReplicate n (Longitude x) = MLongV `liftM` GVM.basicUnsafeReplicate n x+ basicUnsafeCopy (MLongV v1) (MLongV v2) = GVM.basicUnsafeCopy v1 v2+ basicUnsafeGrow (MLongV v) n = MLongV `liftM` GVM.basicUnsafeGrow v n++#if MIN_VERSION_vector(0,11,0)+ basicInitialize (MLongV v) = GVM.basicInitialize v+#endif++instance GV.Vector Vector Longitude where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MLongV v) = LongV `liftM` GV.basicUnsafeFreeze v+ basicUnsafeThaw (LongV v) = MLongV `liftM` GV.basicUnsafeThaw v+ basicLength (LongV v) = GV.basicLength v+ basicUnsafeSlice i n (LongV v) = LongV $ GV.basicUnsafeSlice i n v+ basicUnsafeIndexM (LongV v) i = Longitude `liftM` GV.basicUnsafeIndexM v i++ basicUnsafeCopy (MLongV mv) (LongV v) = GV.basicUnsafeCopy mv v+ elemseq _ (Longitude x) = GV.elemseq (undefined :: Vector a) x
+ geospatial/Naqsha/Geometry/Spherical.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE CPP #-}+-- | Geometric operations on earth surface assuming that earth is a+-- sphere of radius 6371008 m.+--+-- TODO: Port some calculations from+-- http://www.movable-type.co.uk/scripts/latlong.html+--+module Naqsha.Geometry.Spherical+ (+ -- * Distance calculation.+ distance, distance'+ , rMean+ ) where++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+import Data.Group+import Naqsha.Geometry.Coordinate+import Naqsha.Geometry.Angle++--------------------- Distance calculation -------------------------------------++-- | Mean earth radius in meters. This is the radius used in the+-- haversine formula of `dHvs`.+rMean :: Double+rMean = 6371008+++-- | This combinator computes the distance (in meters) between two+-- geo-locations using the haversine distance between two points. For+-- `Position` which have an+distance :: Geo+ -> Geo+ -> Double -- ^ Distance in meters.+distance = distance' rMean+++-- | A generalisation of `distance` that takes the radius as+-- argument. Will work on Mars for example once we set up a latitude+-- longitude system there. For this function units does not matter ---+-- the computed distance is in the same unit as the input radius. We+-- have+--+-- > distance = distance' rMean+--+distance' :: Double -- ^ Radius (in whatever unit)+ -> Geo+ -> Geo+ -> Double++distance' r (Geo lat1 lon1) (Geo lat2 lon2) = r * c+ where p1 = toAngle lat1+ l1 = toAngle lon1+ p2 = toAngle lat2+ l2 = toAngle lon2+ dp = p2 <> invert p1+ dl = l2 <> invert l1++ phi1 = toRadian p1+ phi2 = toRadian p2++ a = hav dp + cos phi1 * cos phi2 * hav dl+ c = 2 * atan2 (sqrt a) (sqrt (1 - a))++-- | The haversine functions.+hav :: Angle -> Double+{-# INLINE hav #-}+hav theta = stheta * stheta+ where stheta = sin (toRadian theta/2.0)
+ geospatial/Naqsha/Version.hs view
@@ -0,0 +1,16 @@+-- | Naqsha library version.+module Naqsha.Version+ ( version+ , versionString+ ) where++import Data.Version+import qualified Paths_naqsha as NP++-- | The version string associated with naqsha.+versionString :: String+versionString = "naqsha-" ++ showVersion version++-- | The naqsha library version+version :: Version+version = NP.version
naqsha.cabal view
@@ -1,22 +1,27 @@+cabal-version: 2.2 name: naqsha-version: 0.2.0.1-synopsis: A library for working with geospatial data types.+version: 0.3.0.0+synopsis: A library for working with anything map related. -description: Naqsha is a library to work with geospatial data types like latitudes and longitudes. It provides- some basic operations like distance calculations.+description: Naqsha is a library to work with geospatial data types,+ like latitudes and longitudes, mapping projects like openstreetmap,+ various map related file formats. homepage: http://github.com/naqsha/naqsha.git -license: BSD3-license-file: LICENSE +copyright: (c) 2016 Piyush P Kurur+license: Apache-2.0 OR BSD-3-Clause+license-files: LICENSE-BSD3+ LICENSE-APACHE-2.0+ author: Piyush P Kurur maintainer: ppk@cse.iitk.ac.in category: Geospatial, Naqsha build-type: Simple-cabal-version: >=1.10+ extra-source-files: CHANGELOG.md , README.md @@ -26,18 +31,25 @@ type: git location: https://github.com/naqsha/naqsha.git -library+----------------------- Common declarations ---------------------------++common defaults+ default-language: Haskell2010 ghc-options: -Wall- build-depends: base >= 4.6 && < 4.11- , bytestring >= 0.9 && < 0.11+ build-depends: base >= 4.10 && < 4.13+ , bytestring >= 0.10 && < 0.11 , groups- , vector >= 0.7.1 && < 0.13+ , vector >= 0.12 && < 0.13 +library geospatial+ import: defaults+ hs-source-dirs: geospatial exposed-modules: Naqsha.Geometry , Naqsha.Geometry.Coordinate.GeoHash , Naqsha.Geometry.Internal , Naqsha.Geometry.Spherical , Naqsha.Version+ autogen-modules: Paths_naqsha other-modules: Paths_naqsha , Naqsha.Geometry.Angle , Naqsha.Geometry.Coordinate@@ -45,22 +57,25 @@ default-language: Haskell2010 test-Suite test+ import: defaults default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs- ghc-options: -Wall- other-modules: Naqsha.Arbitrary- , Naqsha.Geometry.AngleSpec- , Naqsha.Geometry.CoordinateSpec- , Naqsha.Geometry.Coordinate.GeoHashSpec - build-depends: base+ build-depends: , HUnit >= 1.2 , QuickCheck >= 2.4- , groups , hspec+ , hspec-discover -- -- This package --- , naqsha+ , geospatial++ other-modules: Naqsha.Arbitrary+ , Naqsha.Geometry.AngleSpec+ , Naqsha.Geometry.CoordinateSpec+ , Naqsha.Geometry.Coordinate.GeoHashSpec++ build-tool-depends: hspec-discover:hspec-discover