{-# 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)