{-# language OverloadedStrings, DataKinds, DeriveGeneric #-} {-| Module : Web.API.MapQuest.Geocoding Description : Geocoding interface Copyright : (c) Marco Zocca, 2018 License : GPL-3 Maintainer : zocca.marco gmail Stability : experimental Portability : POSIX -} module Web.API.MapQuest.Geocoding (request, GeoQuery(..), Coords(..))where import Data.List (intersperse) import Data.Monoid ((<>)) import Network.HTTP.Req import qualified Data.Text as T import qualified Data.ByteString.Lazy as LBS import GHC.Generics import Control.Monad.Catch import Data.Aeson import Data.Aeson.Types (Parser, parseMaybe) -- https://developer.mapquest.com/documentation/geocoding-api/address/get/ apiRootPath :: Url 'Http apiRootPath = http "www.mapquestapi.com" /: "geocoding" /: "v1" /: "address" -- example request : -- GET http://www.mapquestapi.com/geocoding/v1/address?key=KEY&location=Washington,DC instance MonadHttp IO where handleHttpException = throwM -- | Call the MapQuest Geocoding API with a given address and extract the coordinates from the parsed result. -- -- Example usage : -- assuming the user has bound /key/ to hold the API key string, the following can be run in a GHCi shell : -- -- >>> request key (GQ "Via Irnerio" "Bologna" "Italy") -- Just (Coords {lat = 44.49897, long = 11.34503}) -- -- >>> request key (GQFree "Hong Kong") -- Just (Coords {lat = 22.264412, long = 114.16706}) request :: T.Text -- ^ API key (available for free on ) -> GeoQuery -- ^ Query address -> IO (Maybe (Coords Float)) request apikey q = do r <- req GET apiRootPath NoReqBody lbsResponse opts' return $ decoder1 $ responseBody r where opts' = ("key" =: apikey) <> ("outFormat" =: ("json" :: T.Text)) <> ("location" =: renderGeoQuery q) decoder1 :: LBS.ByteString -> Maybe (Coords Float) decoder1 dat = do r <- decode dat flip parseMaybe r $ \obj -> do locp <- decodeLocation obj decodeLatLong locp decodeLocation :: FromJSON a => Object -> Parser a decodeLocation obj = do (res0 : _) <- obj .: "results" (loc0 : _) <- res0 .: "locations" return loc0 decodeLatLong :: Object -> Parser (Coords Float) decodeLatLong loc = do ll <- loc .: "latLng" Coords <$> ll .: "lat" <*> ll .: "lng" -- | Coordinates data Coords a = Coords { lat :: a -- ^ Latitude , long :: a -- ^ Longitude } deriving (Eq, Show, Generic) -- instance Functor Coords where -- fmap f (Coords x y) = Coords (f x) (f y) -- instance FromJSON a => FromJSON (Coords a) -- | Geocoding query parameters data GeoQuery = GQ { gqStreet :: T.Text -- ^ Street address (e.g. \"Via Irnerio\") , gqCity :: T.Text -- ^ City (e.g. \"Bologna\") , gqCountry :: T.Text -- ^ Country (e.g. \"Italy\") } | GQFree T.Text -- ^ Free-text query (must be a valid address or location) deriving (Eq, Show) renderGeoQuery :: GeoQuery -> T.Text renderGeoQuery q = case q of (GQ addr city country) -> T.concat $ intersperse ", " [addr, city, country] (GQFree t) -> t -- options :: Foldable t => t (T.Text, T.Text) -> Option 'Http -- options = foldr (\(k, v) acc -> (k =: v) <> acc ) mempty