diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, João Cristóvão + +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 João Cristóvão 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/reverse-geocoding.cabal b/reverse-geocoding.cabal new file mode 100644 --- /dev/null +++ b/reverse-geocoding.cabal @@ -0,0 +1,33 @@ +name: reverse-geocoding +version: 0.1.0.0 +synopsis: Simple reverse geocoding using OpenStreeMap +description: Simple reverse geocoding using OpenStreeMap +homepage: https://github.com/jcristovao/reverse-geocoding +license: BSD3 +license-file: LICENSE +author: João Cristóvão +maintainer: jmacristovao@gmail.com +-- copyright: +category: Data +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Data.Geolocation.Reverse.Types + Data.Geolocation.Reverse.Providers + Data.Geolocation.Reverse + -- other-modules: + other-extensions: OverloadedStrings + build-depends: base >= 4.6 && < 4.8 + , lens >= 4.4 && < 4.5 + , lens-aeson >= 1.0 && < 1.1 + , wreq >= 0.2 && < 0.3 + , aeson >= 0.8 && < 0.9 + , text >= 1.2 && < 1.3 + , iso3166-country-codes >= 0.20140203.7 + hs-source-dirs: src + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/jcristovao/reverse-geocoding diff --git a/src/Data/Geolocation/Reverse.hs b/src/Data/Geolocation/Reverse.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geolocation/Reverse.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This very simple module returns a Maybe Location info for a set +-- of coordinates. +-- +-- Right now only one provider is given (OpenStreeMap), and the Suburb/Street +-- parsing could be improved, but this is enough for our needs. +-- +-- Feel free to contribute! +module Data.Geolocation.Reverse where + +import Control.Lens +import Network.Wreq +import Data.Aeson +import Data.Aeson.Types +import Data.Aeson.Lens (key) + +import Data.Geolocation.Reverse.Types +import Data.Geolocation.Reverse.Providers + +-- | Default reverse geo provider +defaultReverseGeoProvider :: ReverseGeoProvider +defaultReverseGeoProvider = openStreetMap + +-- | Given a Latitude and Longitude, return a Location Info. +getLocationInfo + :: Latitude + -> Longitude + -> ReverseGeoProvider + -> IO (Maybe ParsedLocationInfo) +getLocationInfo lat lon (jsonkey,url,parser) = + case url lat lon of + Nothing -> return Nothing + Just ga -> do + r <- get ga + -- addr :: Maybe Value + let addr = r ^? responseBody . key jsonkey + case addr of + Just (Object o) -> return . flip parseMaybe o . return + $ parser o + _ -> return Nothing + +-- | Get location info from default provider (right now Open Stree Map) +getLocationInfoDef :: Latitude -> Longitude -> IO (Maybe ParsedLocationInfo) +getLocationInfoDef lat lon = getLocationInfo lat lon defaultReverseGeoProvider diff --git a/src/Data/Geolocation/Reverse/Providers.hs b/src/Data/Geolocation/Reverse/Providers.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geolocation/Reverse/Providers.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Here we define providers for the Reverse Geocoding feature, +-- namely how to format the url, the key under which the results are returned, +-- and how to parse the retrived data. +-- +-- Currently only Open Stree Map is provided, feel free to add others. +-- +module Data.Geolocation.Reverse.Providers + ( ReverseGeoJsonKey + , ReverseGeoParser + , ReverseGeoProvider + , openStreetMap + + ) where + +import Control.Applicative + +import Data.Monoid +import Data.Aeson +import Data.Aeson.Types +import qualified Data.Text as T + +import Data.Geolocation.Reverse.Types + +type ReverseGeoJsonKey = T.Text +type ReverseGeoUrl = Latitude -> Longitude -> Maybe String +type ReverseGeoParser = Object -> Parser ParsedLocationInfo +type ReverseGeoProvider = (ReverseGeoJsonKey, ReverseGeoUrl, ReverseGeoParser) + + +openStreetMap :: ReverseGeoProvider +openStreetMap = ("address", openStreetMapUrl, openStreetMapParser) + +openStreetMapUrl :: Latitude -> Longitude -> Maybe String +openStreetMapUrl (Latitude mlat) (Longitude mlon) = do + lat <- mlat + lon <- mlon + return $ "http://nominatim.openstreetmap.org/reverse" + <> "?format=json" + <> "&zoom=18" + <> "&lat=" <> show lat + <> "&lon=" <> show lon + + +openStreetMapParser o = + ParsedLocationInfo <$> o .: "country_code" + <*> o .: "city" + <*> o .:? "suburb" + <*> ((o .:? "road") <|> (o .:? "street")) + <*> o .:? "postcode" diff --git a/src/Data/Geolocation/Reverse/Types.hs b/src/Data/Geolocation/Reverse/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geolocation/Reverse/Types.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Geolocation.Reverse.Types where + +import Data.Aeson +import Control.Monad (mzero) +import qualified Data.Text as T +import Data.ISO3166_CountryCodes + +-- | /Input types/ + +-- | Latitude : newtype over double +newtype Latitude = Latitude (Maybe Double) + deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) + +-- | Longitude : newtype over double +newtype Longitude = Longitude (Maybe Double) + deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) + +-- | /Output types/ +newtype City = City T.Text deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) +newtype Suburb = Suburb T.Text deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) +newtype Street = Street T.Text deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) +newtype Postcode= Postcode T.Text deriving (Eq,Ord,Show,Read,FromJSON,ToJSON) + +-- Booo: orphan instances +instance ToJSON CountryCode +instance FromJSON CountryCode where + parseJSON (String t) = return . read . T.unpack . T.toUpper $ t + parseJSON _ = mzero + + +-- | Parsed Location Info: Country code and city are mandatory, all other info is optional +data ParsedLocationInfo + = ParsedLocationInfo + { parsedCountry :: CountryCode + , parsedCity :: City + , parsedSuburb :: Maybe Suburb + , parsedStreet :: Maybe Street + , parsedPostCode :: Maybe Postcode + } deriving (Eq,Ord,Show)