naqsha (empty) → 0.1.0.0
raw patch · 13 files changed
+838/−0 lines, 13 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, data-default, groups, hspec, naqsha, vector
Files
- CHANGELOG.md +13/−0
- LICENSE +30/−0
- Naqsha.hs +9/−0
- Naqsha/Geometry/Angle.hs +152/−0
- Naqsha/Geometry/Spherical.hs +63/−0
- Naqsha/Position.hs +361/−0
- Naqsha/Version.hs +16/−0
- Setup.lhs +4/−0
- naqsha.cabal +61/−0
- tests/Main.hs +1/−0
- tests/Naqsha/Arbitrary.hs +28/−0
- tests/Naqsha/Geometry/AngleSpec.hs +30/−0
- tests/Naqsha/PositionSpec.hs +70/−0
+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Change log for [naqsha]++## [0.1.0.0] - 6th May, 2017++Very first release of naqsha.++* Basic Geo types, Angles, Latitudes and Longitudes++* Haversine distance calculation.+++[naqsha]: <http://github.com/naqsha/naqsha/> "Naqsha library"+[0.1.0.0]: <https://github.com/naqsha/naqsha/releases/tag/v0.1.0.0> "Release 0.1.0.0"
+ LICENSE 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.hs view
@@ -0,0 +1,9 @@+-- | Naqsha is a library to work with geo data. This module exposes+-- the basic types and some utility functions.+module Naqsha+ ( module Naqsha.Position+ , module Naqsha.Geometry.Angle+ ) where++import Naqsha.Position+import Naqsha.Geometry.Angle
+ Naqsha/Geometry/Angle.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- | Basic types associated with geometry.+module Naqsha.Geometry.Angle+ ( Angle+ , degree , minute, second+ , radian+ , toDegree, toRadian+ , Angular(..)+ ) where+++import Control.Monad ( liftM )+import Data.Default+import Data.Group+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+++----------------------------- 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)++-- | 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))++instance Default Angle where+ def = Angle 0++instance Angular Angle where+ toAngle = id++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++------------------------------ The angular class ------------------------++-- | Angular quantities.+class Angular a where+ toAngle :: a -> Angle++------------------- 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
+ Naqsha/Geometry/Spherical.hs view
@@ -0,0 +1,63 @@+-- | Geometric operations on earth surface assuming that earth is a+-- sphere of radius 6371008 m.+module Naqsha.Geometry.Spherical+ (+ -- * Distance calculation.+ distance, distance'+ , rMean+ ) where++import Data.Monoid+import Data.Group+import Naqsha.Position+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 `dHvS` 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/Position.hs view
@@ -0,0 +1,361 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Rank2Types #-}+-- | This module captures position of a point on the globe.+module Naqsha.Position+ ( -- * Basics+ -- $latandlong$+ Geo(..)+ , northPole, southPole+ -- ** Latitudes+ , Latitude+ , north, south, lat+ , equator+ , tropicOfCancer+ , tropicOfCapricon+ -- ** Longitudes.+ , Longitude+ , east, west, lon+ , greenwich+ ) where++import Control.Monad ( liftM )+import Data.Default+import Data.Fixed+import Data.Monoid+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 Text.Read++import Prelude -- To avoid redundunt import warnings.++import Naqsha.Geometry.Angle++-- $latandlong$+--+-- A point on the globe is specified by giving its geo coordinates+-- captures 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+--+--+-- > 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 and negative means south. For+-- longitudes, positive means east 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.+--+++----------------------------- Lattitude ----------------------------------++-- | The latitude of a point. Positive denotes North of Equator where+-- as negative South.+newtype Latitude = Latitude { unLat :: Angle } deriving (Eq, Ord)++-- | Construct latitude out of an angle.+lat :: Angle -> Latitude+lat = Latitude . normLat++-- | 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+++instance Angular Latitude where+ toAngle = unLat++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 Default Latitude where+ def = equator++-- | 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+++instance Bounded Latitude where+ maxBound = lat $ degree 90+ minBound = lat $ degree (-90)+++-------------------------- 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, Default, Angular, Ord, Monoid, Group)++instance Show Longitude where+ show = show . (toDegree :: Angle -> Nano) . unLong++instance Read Longitude where+ readPrec = conv <$> readPrec+ where conv = lon . degree . (toRational :: Nano -> Rational)++-- | Convert angles to longitude.+lon :: Angle -> Longitude+lon = Longitude++-- | 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 coordinates of a point on the earth's surface.+data Geo = Geo {-# UNPACK #-} !Latitude+ {-# UNPACK #-} !Longitude+ deriving Show++instance Default Geo where+ def = Geo def def+++-- | 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++-- | 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+++--------------------------- 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)+++newtype instance MVector s Geo = MGeoV (MVector s (Angle,Angle))+newtype instance Vector Geo = GeoV (Vector (Angle,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+++----------------------------- Instance for Geo ---------------------------------------------++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/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
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ naqsha.cabal view
@@ -0,0 +1,61 @@+name: naqsha+version: 0.1.0.0+synopsis: A library for working with geospatial data types.++description: Naqsha is a library to work with geospatial data types like latitudes and longitudes. It provides+ some basic operations like distance calculations.++homepage: http://github.com/naqsha/naqsha.git++license: BSD3+license-file: LICENSE++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+++bug-reports: https://github.com/naqsha/naqsha/issues++source-repository head+ type: git+ location: https://github.com/naqsha/naqsha.git++library+ ghc-options: -Wall+ build-depends: base >= 4.6 && < 4.11+ , data-default+ , groups+ , vector >= 0.7.1 && < 0.13++ exposed-modules: Naqsha+ , Naqsha.Position+ , Naqsha.Geometry.Angle+ , Naqsha.Geometry.Spherical+ , Naqsha.Version+ other-modules: Paths_naqsha+ default-language: Haskell2010++test-Suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ ghc-options: -Wall+ other-modules: Naqsha.PositionSpec+ , Naqsha.Geometry.AngleSpec+ , Naqsha.Arbitrary+ build-depends: base+ , HUnit >= 1.2+ , QuickCheck >= 2.4+ , groups+ , hspec+ --+ -- This package+ --+ , naqsha == 0.1.0.0
+ tests/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/Naqsha/Arbitrary.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Naqsha.Arbitrary where++import Test.QuickCheck+++import Naqsha+++instance Arbitrary Angle where+ arbitrary = toEnum <$> arbitrary++instance Arbitrary Latitude where+ arbitrary = lat <$> arbitrary++instance Arbitrary Longitude where+ arbitrary = lon <$> arbitrary+++instance Arbitrary Geo where+ arbitrary = Geo <$> arbitrary <*> arbitrary
+ tests/Naqsha/Geometry/AngleSpec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Naqsha.Geometry.AngleSpec where++import Data.Monoid+import Data.Group+import Test.Hspec+import Test.Hspec.QuickCheck++import Naqsha+import Naqsha.Arbitrary ()++spec :: Spec+spec = describe "Group laws for Angle" $ do++ -- Commutative group under (+)+ prop "x <> mempty = x" $ \ (x :: Angle)+ -> (x <> mempty) `shouldBe` x+ prop "mempty <> x" $ \ (x :: Angle)+ -> (x <> mempty) `shouldBe` x++ prop "(<>) should be commutative" $ \ (x :: Angle) y+ -> (x <> y) `shouldBe` (y <> x)+ prop "(<>) should be associative" $ \ (x :: Angle) y z+ -> (x <> (y <> z)) `shouldBe` ((x <> y) <> z)+ prop "x <> invert x = mempty" $ \ (x :: Angle)+ -> (x <> invert x) `shouldBe` mempty+++ let range = show (minBound :: Angle, maxBound :: Angle)+ in prop ("should be in range " ++ range) $ \ (x :: Angle) -> x >= minBound && x <= maxBound
+ tests/Naqsha/PositionSpec.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Naqsha.PositionSpec where+import Data.Monoid+import Data.Fixed+import Test.QuickCheck+import Test.Hspec+import Test.Hspec.QuickCheck++import Naqsha.Position+import Naqsha.Geometry.Angle+import Naqsha.Arbitrary ()++inRange :: Testable prop+ => (Angle, Angle) -- ^ Range+ -> String -- ^ description+ -> ((Angle,Angle) -> prop)+ -> Spec+inRange (mi,mx) descr prop_test = it msg $ forAll pair prop_test+ where pair = (,) <$> gen <*> gen+ msg = "in range " ++ show (toNano mi,toNano mx) ++ ": " ++ descr+ gen = toEnum <$> choose (fromEnum mi, fromEnum mx)++ toNano :: Angle -> Nano+ toNano = toDegree++isIncreasing :: (Angle, Angle) -> Bool+isIncreasing (x , y)+ | x == y = xA == yA+ | x < y = xA < yA+ | otherwise = xA > yA+ where xA = lat x+ yA = lat y+++isDecreasing :: (Angle, Angle) -> Bool+isDecreasing (x, y)+ | x == y = xA == yA+ | x > y = xA < yA+ | otherwise = xA > yA+ where xA = lat x+ yA = lat y++shouldBeBounded :: (Arbitrary a, Ord a, Show a, Bounded a) => a -> Spec+shouldBeBounded a = prop msg $ \ x -> x >= mi && x <= mx+ where msg = unwords [ "should lie between"+ , show mi+ , "and"+ , show mx+ ]+ mi = minBound `asTypeOf` a+ mx = maxBound `asTypeOf` a+++spec :: Spec+spec = do++ describe "latitudes" $ do++ inRange (degree (-90), degree 90) "increases monotonically" isIncreasing+ inRange (degree 90 , maxBound) "decreases monotonically" isDecreasing+ inRange (minBound , degree (-90)) "decreases monotonically" isDecreasing++ shouldBeBounded (undefined :: Latitude)++ describe "longitudes" $ do++ prop "should have a period of 360 deg" $+ \ (x :: Longitude) -> x <> lon (degree 360) `shouldBe` x++ shouldBeBounded (undefined ::Longitude)