google-maps-geocoding (empty) → 0.1.0.0

raw patch · 4 files changed

+306/−0 lines, 4 filesdep +aesondep +basedep +http-clientsetup-changed

Dependencies added: aeson, base, http-client, servant, servant-client, text

Files

LICENSE +30/−0
Setup.hs +2/−0
google-maps-geocoding.cabal +31/−0
src/Web/Google/Maps/Geocoding.hs +243/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Mike Pilgrem (c) 2017++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 Mike Pilgrem 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ google-maps-geocoding.cabal view

@@ -0,0 +1,31 @@+name:                google-maps-geocoding+version:             0.1.0.0+synopsis:            Google Maps Geocoding API bindings+description:         The Google Maps Geocoding API provides a direct way to+                     access geocoding and reverse geocoding services via an HTTP+                     request.+homepage:            https://github.com/mpilgrem/google-maps-geocoding#readme+bug-reports:         https://github.com/mpilgrem/google-maps-geocoding/issues+license:             BSD3+license-file:        LICENSE+author:              Mike Pilgrem+maintainer:          public@pilgrem.com+copyright:           Mike Pilgrem+category:            Web+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Web.Google.Maps.Geocoding+  build-depends:       base >= 4.7 && < 5+                     , aeson >= 1.0 && < 1.1+                     , http-client >= 0.5 && < 0.6+                     , servant >= 0.9 && < 0.10+                     , servant-client >= 0.9 && <0.10+                     , text >= 1.2 && < 1.3+  default-language:    Haskell2010++source-repository head+  type:                git+  location:            https://github.com/mpilgrem/google-maps-geocoding.git

+ src/Web/Google/Maps/Geocoding.hs view

@@ -0,0 +1,243 @@+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TypeOperators              #-}
+
+-- |
+-- Module      : Web.Google.Maps.Geocoding
+-- Description : Bindings to the Google Maps Geocoding API
+-- Copyright   : (c) Mike Pilgrem 2017
+-- Maintainer  : public@pilgrem.com
+-- Stability   : experimental
+-- 
+-- The <https://developers.google.com/maps/documentation/geocoding/intro Google Maps Geocoding API>
+-- provides a direct way to access geocoding and reverse geocoding services via
+-- an HTTP request.
+--
+-- The 'components' and optional parameters in a geocoding request are not yet
+-- implemented. The reverse geocoding request is not yet implemented.
+--
+-- Below is an example of use.
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- >
+-- > module Main (main) where
+-- >
+-- > import Data.Text (Text)
+-- > import Data.Text.IO as T (getLine, putStr)
+-- > import Network.HTTP.Client (newManager)
+-- > import Network.HTTP.Client.TLS (tlsManagerSettings)
+-- > import Web.Google.Maps.Geocoding (Address (..), geocode, GeocodingResponse (..),
+-- >     Geometry (..), Key (..), Location (..), Result (..), Status (..))
+-- > import System.IO (hFlush, stdout)
+-- >
+-- > main :: IO ()
+-- > main = do
+-- >     txt <- input "Enter full address: "
+-- >     mgr <- newManager tlsManagerSettings
+-- >     let apiKey = Key "<GOOGLE_API_KEY>"
+-- >     result <- geocode mgr apiKey (Address txt)
+-- >     case result of
+-- >         Right response -> do
+-- >             let s = status response
+-- >             case s of
+-- >                OK -> print $ location $ geometry $ head $ results response
+-- >                 _  -> putStrLn $ "Error! Status: " ++ show s
+-- >         _ -> putStrLn $ "Error! Result:\n" ++ show result
+-- >
+-- > input :: Text -> IO Text
+-- > input msg = T.putStr msg >> hFlush stdout >> T.getLine
+module Web.Google.Maps.Geocoding
+       ( -- * Functions
+         geocode
+         -- * API
+       , GoogleMapsGeocodingAPI
+       , api
+         -- * Types
+       , Key                  (..)
+       , Address              (..)
+       , GeocodingResponse    (..)
+       , Status               (..)
+       , Result               (..)
+       , AddressType          (..)
+       , AddressComponent     (..)
+       , PostcodeLocality     (..)
+       , Geometry             (..)
+       , PlaceId              (..)
+       , Location             (..)
+       , LocationType         (..)
+       , Viewport             (..)
+       ) where
+
+import           Data.Aeson hiding (Result)
+import           Data.Aeson.Types (Options (..))
+import           Data.Foldable (asum)
+import           Data.Proxy
+import           Data.Text (Text)
+import qualified Data.Text as T (unpack)
+import           GHC.Generics
+import           Network.HTTP.Client (Manager)
+import           Servant.API
+import           Servant.Client
+
+-- | API key
+newtype Key = Key Text
+    deriving (Eq, Show, ToHttpApiData)
+
+-- | Address
+newtype Address = Address Text
+    deriving (Eq, Show, ToHttpApiData)
+
+-- | Geocoding Reponse
+data GeocodingResponse = GeocodingResponse
+    { status        :: Status
+    , error_message :: Maybe Text
+    , results       :: [Result]
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON GeocodingResponse
+
+-- | Contains the status of the request and may contain debugging information to
+--  help you track down why geocoding is not working.
+data Status
+    = OK              -- ^ Indicates that no errors occurred; the address was
+                      -- successfully parsed and at least one geocode was
+                      -- returned.
+    | ZeroResults     -- ^ Indicates that the geocode was successful but
+                      -- returned no results. This may occur if the geocoder was
+                      -- passed a non-existent address.
+    | OverQueryLimit
+    | RequestDenied
+    | InvalidRequest  -- ^ Generally indicates that the query (address,
+                      -- components or latlng) is missing.
+    | UnknownError
+    deriving (Eq, Show)
+
+instance FromJSON Status where
+    parseJSON = withText "Status" $ \t -> case t of
+        "OK"               -> return OK
+        "ZERO_RESULTS"     -> return ZeroResults
+        "OVER_QUERY_LIMIT" -> return OverQueryLimit
+        "REQUEST_DENIED"   -> return RequestDenied
+        "INVALID_REQUEST"  -> return InvalidRequest
+        "UNKNOWN_ERROR"    -> return UnknownError
+        _                  -> fail $ "Unrecognised status type, namely: " ++
+                                  T.unpack t
+
+-- | A result of the geocoder.
+data Result = Result
+    { types :: [AddressType]
+    , formatted_address :: Text
+    , address_components :: [AddressComponent]
+    , postcode_localities :: Maybe [PostcodeLocality]
+    , geometry :: Geometry
+    , partial_match :: Maybe Bool
+    , place_id :: PlaceId
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON Result
+
+-- | Address (and address component) type: The list of types provided by Google
+-- (as at 4 March 2017) is incomplete.
+data AddressType = AddressType Text
+    deriving (Eq, Show, Generic)
+
+instance FromJSON AddressType
+
+-- | Address component
+data AddressComponent = AddressComponent
+    { address_component_types      :: [AddressType]
+    , long_name  :: Text
+    , short_name :: Text
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON AddressComponent where
+    parseJSON = genericParseJSON defaultOptions
+        { fieldLabelModifier = \l -> case l of
+            "address_component_types" -> "types"
+            _ -> l
+        }
+
+-- | Postcode locality: a locality contained in a postal code
+newtype PostcodeLocality = PostcodeLocality Text
+    deriving (Eq, Show, Generic)
+
+instance FromJSON PostcodeLocality
+
+-- | Geometry
+data Geometry = Geometry
+    { location :: Location
+    , location_type :: LocationType
+    , viewport :: Viewport
+    , bounds :: Maybe Viewport
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON Geometry
+
+-- | Location
+data Location = Location
+    { lat :: Double
+    , lng :: Double
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON Location
+
+-- | Location type
+data LocationType
+    = Rooftop
+    | RangeInterpolated
+    | GeometricCenter
+    | Approximate
+    deriving (Eq, Show)
+
+instance FromJSON LocationType where
+    parseJSON = withText "LocationType" $ \t -> case t of
+        "ROOFTOP"            -> return Rooftop
+        "RANGE_INTERPOLATED" -> return RangeInterpolated
+        "GEOMETRIC_CENTER"   -> return GeometricCenter
+        "APPROXIMATE"        -> return Approximate
+        _ -> fail $ "Unrecognised location type, namely: " ++ T.unpack t
+
+-- | Viewport
+data Viewport = Viewport
+    { southwest :: Location
+    , northeast :: Location
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON Viewport
+
+-- | Place id
+newtype PlaceId = PlaceId Text
+    deriving (Eq, Show, Generic)
+
+instance FromJSON PlaceId
+
+-- | Google Translate API
+type GoogleMapsGeocodingAPI
+    =  "json"
+    :> QueryParam "key" Key
+    :> QueryParam "address" Address
+    :> Get '[JSON] GeocodingResponse
+
+-- | API type
+api :: Proxy GoogleMapsGeocodingAPI
+api = Proxy
+
+geocode'
+    :: Maybe Key
+    -> Maybe Address
+    -> ClientM GeocodingResponse
+geocode' = client api
+
+googleApis :: BaseUrl
+googleApis = BaseUrl Https "maps.googleapis.com" 443 "/maps/api/geocode"
+
+-- | Geocode
+geocode
+    :: Manager
+    -> Key
+    -> Address
+    -> IO (Either ServantError GeocodingResponse)
+geocode mgr key address =
+    runClientM (geocode' (Just key) (Just address)) (ClientEnv mgr googleApis)