diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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]: "Naqsha library" +[0.2.0.2]: "Release 0.2.0.1" +[0.2.0.1]: "Release 0.2.0.1" [0.2.0.0]: "Release 0.2.0.0" [0.1.0.0]: "Release 0.1.0.0" diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -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. diff --git a/LICENSE-APACHE-2.0 b/LICENSE-APACHE-2.0 new file mode 100644 --- /dev/null +++ b/LICENSE-APACHE-2.0 @@ -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. diff --git a/LICENSE-BSD3 b/LICENSE-BSD3 new file mode 100644 --- /dev/null +++ b/LICENSE-BSD3 @@ -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. diff --git a/Naqsha/Geometry.hs b/Naqsha/Geometry.hs deleted file mode 100644 --- a/Naqsha/Geometry.hs +++ /dev/null @@ -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 --- (). --- --- 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. diff --git a/Naqsha/Geometry/Angle.hs b/Naqsha/Geometry/Angle.hs deleted file mode 100644 --- a/Naqsha/Geometry/Angle.hs +++ /dev/null @@ -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 diff --git a/Naqsha/Geometry/Coordinate.hs b/Naqsha/Geometry/Coordinate.hs deleted file mode 100644 --- a/Naqsha/Geometry/Coordinate.hs +++ /dev/null @@ -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) diff --git a/Naqsha/Geometry/Coordinate/GeoHash.hs b/Naqsha/Geometry/Coordinate/GeoHash.hs deleted file mode 100644 --- a/Naqsha/Geometry/Coordinate/GeoHash.hs +++ /dev/null @@ -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 diff --git a/Naqsha/Geometry/Internal.hs b/Naqsha/Geometry/Internal.hs deleted file mode 100644 --- a/Naqsha/Geometry/Internal.hs +++ /dev/null @@ -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 diff --git a/Naqsha/Geometry/Spherical.hs b/Naqsha/Geometry/Spherical.hs deleted file mode 100644 --- a/Naqsha/Geometry/Spherical.hs +++ /dev/null @@ -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) diff --git a/Naqsha/Version.hs b/Naqsha/Version.hs deleted file mode 100644 --- a/Naqsha/Version.hs +++ /dev/null @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 + +* BSD 3-Clause license + + +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]: "Build status" [travis-naqsha]: diff --git a/geospatial/Naqsha/Geometry.hs b/geospatial/Naqsha/Geometry.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry.hs @@ -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 +-- (). +-- +-- 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. diff --git a/geospatial/Naqsha/Geometry/Angle.hs b/geospatial/Naqsha/Geometry/Angle.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry/Angle.hs @@ -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 diff --git a/geospatial/Naqsha/Geometry/Coordinate.hs b/geospatial/Naqsha/Geometry/Coordinate.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry/Coordinate.hs @@ -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) diff --git a/geospatial/Naqsha/Geometry/Coordinate/GeoHash.hs b/geospatial/Naqsha/Geometry/Coordinate/GeoHash.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry/Coordinate/GeoHash.hs @@ -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 diff --git a/geospatial/Naqsha/Geometry/Internal.hs b/geospatial/Naqsha/Geometry/Internal.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry/Internal.hs @@ -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 diff --git a/geospatial/Naqsha/Geometry/Spherical.hs b/geospatial/Naqsha/Geometry/Spherical.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Geometry/Spherical.hs @@ -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) diff --git a/geospatial/Naqsha/Version.hs b/geospatial/Naqsha/Version.hs new file mode 100644 --- /dev/null +++ b/geospatial/Naqsha/Version.hs @@ -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 diff --git a/naqsha.cabal b/naqsha.cabal --- a/naqsha.cabal +++ b/naqsha.cabal @@ -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