{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeOperators              #-}

-- |

-- Module      : Web.Google.Maps.Static

-- Description : Bindings to the Google Maps Static API (formerly Static Maps

--               API)

-- Copyright   : (c) Mike Pilgrem 2017, 2018, 2024

-- Maintainer  : public@pilgrem.com

-- Stability   : experimental

--

-- This module has no connection with Google Inc. or its affiliates.

--

-- The <https://developers.google.com/maps/documentation/maps-static Google Maps Static API>

-- returns a map as an image via an HTTP request. This library provides bindings

-- in Haskell to that API (version 2).

--

-- NB: The use of the Google Maps Static API services is subject to the

-- <https://cloud.google.com/maps-platform/terms/ Google Maps Platform Terms of Service>,

-- which terms restrict the use of content. End Users' use of Google Maps is

-- subject to the then-current Google Maps/Google Earth Additional Terms of

-- Service at <https://maps.google.com/help/terms_maps.html> and Google Privacy

-- Policy at <https://www.google.com/policies/privacy/>.

--

-- The following are not yet implemented: non-PNG image formats; and encoded

-- polyline paths.

--

-- The code below is an example console application to test the use of the

-- library with the Google Maps Static API.

--

-- > {-# LANGUAGE OverloadedStrings #-}

-- >

-- > module Main (main) where

-- >

-- > import Data.Maybe (fromJust)

-- > import Graphics.Gloss (Display (..), display, white)  -- package gloss

-- > import Graphics.Gloss.Juicy (fromDynamicImage)        -- package gloss-juicy

-- > import Network.HTTP.Client (newManager)

-- > import Network.HTTP.Client.TLS (tlsManagerSettings)

-- > import Web.Google.Maps.Static (Center (..), Key (..), Location (..), Size (..),

-- >     staticmap, StaticmapResponse (..), Zoom (..))

-- >

-- > main :: IO ()

-- > main = do

-- >   putStrLn $ "A test of the Google Maps Static API.\nNB: The use of " ++

-- >     "the API services is subject to the Google Maps Platform Terms of " ++

-- >     "Serivce at https://cloud.google.com/maps-platform/terms/.\n"

-- >   mgr <- newManager tlsManagerSettings

-- >   let apiKey = Key "<REPLACE_THIS_WITH_YOUR_ACTUAL_GOOGLE_API_KEY>"

-- >       -- If using a digital signature ...

-- >       secret = Just $ Secret

-- >         "<REPLACE_THIS_WITH_YOUR_ACTUAL_GOOGLE_URL_SIGNING_SECRET>"

-- >       center = Just $ Center (Location 42.165950 (-71.362015))

-- >       zoom   = Just $ Zoom 17

-- >       w      = 400

-- >       h      = 400

-- >       size   = Size w h

-- >   result <- staticmap mgr apiKey secret center zoom size Nothing Nothing

-- >               [] Nothing Nothing Nothing [] [] Nothing

-- >   case result of

-- >     Right response -> do

-- >       let picture = fromJust $ fromDynamicImage response

-- >           title   = "Test Google Maps Static API"

-- >           window  = InWindow title (w, h) (10, 10)

-- >       display window white picture

-- >     Left err -> putStrLn $ "Error! Result:\n" ++ show err

module Web.Google.Maps.Static
  ( -- * Functions

    staticmap
    -- * API

  , GoogleMapsStaticAPI
  , api
    -- * Types

  , Key               (..)
  , Secret            (..)
  , Signature         (..)
  , Center            (..)
  , Location          (..)
  , LatLng            (..)
  , Address           (..)
  , Zoom              (..)
  , Size              (..)
  , Scale             (..)
  , Format            (..)
  , MapStyle          (..)
  , Feature           (..)
  , Element           (..)
  , MapStyleOp        (..)
  , Visibility        (..)
  , MapType           (..)
  , Language          (..)
  , Region            (..)
  , Markers           (..)
  , MarkerStyle       (..)
  , MarkerSize        (..)
  , MarkerColor       (..)
  , MarkerLabel       (..)
  , StdColor          (..)
  , URI               (..)
  , URIAuth           (..)
  , Anchor            (..)
  , StdAnchor         (..)
  , Path              (..)
  , PathStyle         (..)
  , PathWeight        (..)
  , PathColor         (..)
  , PathGeodesic      (..)
  , Visible           (..)
  , StaticmapResponse
  ) where

import           Codec.Picture.Types ( DynamicImage (..) )
import           Crypto.Hash.Algorithms ( SHA1 )
import           Crypto.MAC.HMAC ( HMAC, hmac )
import           Data.ByteArray ( convert )
import           Data.ByteString.Base64.URL ( decode, encode )
import           Data.ByteString.UTF8 as UTF8 ( fromString )
import           Data.List ( intersperse )
import           Data.Maybe ( catMaybes )
import           Data.Proxy ( Proxy (..) )
import           Data.Text ( Text )
import qualified Data.Text as T ( append, concat, pack )
import           Data.Text.Encoding ( decodeUtf8, encodeUtf8 )
import           Data.Word ( Word8 )
import           Network.HTTP.Client ( Manager )
import           Network.URI ( URI (..), URIAuth (..), uriToString )
import           Servant.API
                   ( (:>), Get, QueryParam, QueryParams, safeLink
                   , ToHttpApiData (..)
                   )
import          Servant.Client
                  ( BaseUrl (..), client, ClientEnv (ClientEnv), ClientM
                  , runClientM, ClientError
                  )
#if MIN_VERSION_servant_client(0,17,0)
import           Servant.Client ( defaultMakeClientRequest )
#endif
import           Servant.JuicyPixels ( PNG )
import           Servant.Links ( LinkArrayElementStyle (..), linkURI' )
import           Text.Bytedump ( hexString )
import           Web.Google.Maps.Common
                   ( Address (..), googleMapsApis, Key (..), Language (..)
                   , LatLng (..), Location (..), Region (..)
                   )

-- | Secret for digital signature

newtype Secret = Secret Text
  deriving (Secret -> Secret -> Bool
(Secret -> Secret -> Bool)
-> (Secret -> Secret -> Bool) -> Eq Secret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Secret -> Secret -> Bool
== :: Secret -> Secret -> Bool
$c/= :: Secret -> Secret -> Bool
/= :: Secret -> Secret -> Bool
Eq, Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> String
(Int -> Secret -> ShowS)
-> (Secret -> String) -> ([Secret] -> ShowS) -> Show Secret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Secret -> ShowS
showsPrec :: Int -> Secret -> ShowS
$cshow :: Secret -> String
show :: Secret -> String
$cshowList :: [Secret] -> ShowS
showList :: [Secret] -> ShowS
Show)

-- | Signature

newtype Signature = Signature Text
  deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, Signature -> ByteString
Signature -> Text
Signature -> Builder
(Signature -> Text)
-> (Signature -> Builder)
-> (Signature -> ByteString)
-> (Signature -> Text)
-> (Signature -> Builder)
-> ToHttpApiData Signature
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Signature -> Text
toUrlPiece :: Signature -> Text
$ctoEncodedUrlPiece :: Signature -> Builder
toEncodedUrlPiece :: Signature -> Builder
$ctoHeader :: Signature -> ByteString
toHeader :: Signature -> ByteString
$ctoQueryParam :: Signature -> Text
toQueryParam :: Signature -> Text
$ctoEncodedQueryParam :: Signature -> Builder
toEncodedQueryParam :: Signature -> Builder
ToHttpApiData)

-- | Center of the map: not required if the map includes markers or paths.

newtype Center = Center Location
  deriving (Center -> Center -> Bool
(Center -> Center -> Bool)
-> (Center -> Center -> Bool) -> Eq Center
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Center -> Center -> Bool
== :: Center -> Center -> Bool
$c/= :: Center -> Center -> Bool
/= :: Center -> Center -> Bool
Eq, Int -> Center -> ShowS
[Center] -> ShowS
Center -> String
(Int -> Center -> ShowS)
-> (Center -> String) -> ([Center] -> ShowS) -> Show Center
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Center -> ShowS
showsPrec :: Int -> Center -> ShowS
$cshow :: Center -> String
show :: Center -> String
$cshowList :: [Center] -> ShowS
showList :: [Center] -> ShowS
Show, Center -> ByteString
Center -> Text
Center -> Builder
(Center -> Text)
-> (Center -> Builder)
-> (Center -> ByteString)
-> (Center -> Text)
-> (Center -> Builder)
-> ToHttpApiData Center
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Center -> Text
toUrlPiece :: Center -> Text
$ctoEncodedUrlPiece :: Center -> Builder
toEncodedUrlPiece :: Center -> Builder
$ctoHeader :: Center -> ByteString
toHeader :: Center -> ByteString
$ctoQueryParam :: Center -> Text
toQueryParam :: Center -> Text
$ctoEncodedQueryParam :: Center -> Builder
toEncodedQueryParam :: Center -> Builder
ToHttpApiData)

-- | Zoom level: the lowest level, in which the whole world can be seen, is 0.

-- Each succeeding level doubles the precision. Not required if the map includes

-- markers or paths.

newtype Zoom = Zoom Int
  deriving (Zoom -> Zoom -> Bool
(Zoom -> Zoom -> Bool) -> (Zoom -> Zoom -> Bool) -> Eq Zoom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Zoom -> Zoom -> Bool
== :: Zoom -> Zoom -> Bool
$c/= :: Zoom -> Zoom -> Bool
/= :: Zoom -> Zoom -> Bool
Eq, Int -> Zoom -> ShowS
[Zoom] -> ShowS
Zoom -> String
(Int -> Zoom -> ShowS)
-> (Zoom -> String) -> ([Zoom] -> ShowS) -> Show Zoom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Zoom -> ShowS
showsPrec :: Int -> Zoom -> ShowS
$cshow :: Zoom -> String
show :: Zoom -> String
$cshowList :: [Zoom] -> ShowS
showList :: [Zoom] -> ShowS
Show, Zoom -> ByteString
Zoom -> Text
Zoom -> Builder
(Zoom -> Text)
-> (Zoom -> Builder)
-> (Zoom -> ByteString)
-> (Zoom -> Text)
-> (Zoom -> Builder)
-> ToHttpApiData Zoom
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Zoom -> Text
toUrlPiece :: Zoom -> Text
$ctoEncodedUrlPiece :: Zoom -> Builder
toEncodedUrlPiece :: Zoom -> Builder
$ctoHeader :: Zoom -> ByteString
toHeader :: Zoom -> ByteString
$ctoQueryParam :: Zoom -> Text
toQueryParam :: Zoom -> Text
$ctoEncodedQueryParam :: Zoom -> Builder
toEncodedQueryParam :: Zoom -> Builder
ToHttpApiData)

-- | Size in pixels: there are maximum allowable values.

data Size = Size
  { Size -> Int
width  :: Int
  , Size -> Int
height :: Int
  } deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show)

instance ToHttpApiData Size where
  toUrlPiece :: Size -> Text
toUrlPiece (Size Int
width' Int
height') =
    String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
width' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
height')

-- | Scale

data Scale
  = Single     -- ^ The default value.

  | Double
  | Quadruple
  deriving (Scale -> Scale -> Bool
(Scale -> Scale -> Bool) -> (Scale -> Scale -> Bool) -> Eq Scale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scale -> Scale -> Bool
== :: Scale -> Scale -> Bool
$c/= :: Scale -> Scale -> Bool
/= :: Scale -> Scale -> Bool
Eq, Int -> Scale -> ShowS
[Scale] -> ShowS
Scale -> String
(Int -> Scale -> ShowS)
-> (Scale -> String) -> ([Scale] -> ShowS) -> Show Scale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scale -> ShowS
showsPrec :: Int -> Scale -> ShowS
$cshow :: Scale -> String
show :: Scale -> String
$cshowList :: [Scale] -> ShowS
showList :: [Scale] -> ShowS
Show)

instance ToHttpApiData Scale where
  toUrlPiece :: Scale -> Text
toUrlPiece Scale
scale = case Scale
scale of
    Scale
Single    -> Text
"1"
    Scale
Double    -> Text
"2"
    Scale
Quadruple -> Text
"4"

-- | Image format

data Format
  = Png8   -- ^ The default value.

  | Png32
  deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show)

instance ToHttpApiData Format where
  toUrlPiece :: Format -> Text
toUrlPiece Format
format = case Format
format of
    Format
Png8  -> Text
"png8"
    Format
Png32 -> Text
"png32"

-- | MapStyle

data MapStyle = MapStyle (Maybe Feature) (Maybe Element) [MapStyleOp]
  deriving (MapStyle -> MapStyle -> Bool
(MapStyle -> MapStyle -> Bool)
-> (MapStyle -> MapStyle -> Bool) -> Eq MapStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MapStyle -> MapStyle -> Bool
== :: MapStyle -> MapStyle -> Bool
$c/= :: MapStyle -> MapStyle -> Bool
/= :: MapStyle -> MapStyle -> Bool
Eq, Int -> MapStyle -> ShowS
[MapStyle] -> ShowS
MapStyle -> String
(Int -> MapStyle -> ShowS)
-> (MapStyle -> String) -> ([MapStyle] -> ShowS) -> Show MapStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MapStyle -> ShowS
showsPrec :: Int -> MapStyle -> ShowS
$cshow :: MapStyle -> String
show :: MapStyle -> String
$cshowList :: [MapStyle] -> ShowS
showList :: [MapStyle] -> ShowS
Show)

instance ToHttpApiData MapStyle where
  toUrlPiece :: MapStyle -> Text
toUrlPiece (MapStyle Maybe Feature
featureOpt Maybe Element
elementOpt [MapStyleOp]
ops) =
    [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
featureUrl, Maybe Text
elementUrl] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
opsUrl]
   where
    featureUrl :: Maybe Text
featureUrl = Text -> Text -> Text
T.append Text
"feature:" (Text -> Text) -> (Feature -> Text) -> Feature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (Feature -> Text) -> Maybe Feature -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Feature
featureOpt
    elementUrl :: Maybe Text
elementUrl = Text -> Text -> Text
T.append Text
"element:" (Text -> Text) -> (Element -> Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Element
elementOpt
    opsUrl :: Text
opsUrl = [MapStyleOp] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [MapStyleOp]
ops

-- | Map feature

data Feature
  = AllFeatures
  | Administrative
  | AdministrativeCountry
  | AdministrativeLandParcel
  | AdministrativeLocality
  | AdministrativeNeighborhood
  | AdministrativeProvince
  | Landscape
  | LandscapeManMade
  | LandscapeNatural
  | LandscapeNaturalLandcover
  | LandscapeNaturalTerrain
  | Poi
  | PoiAttraction
  | PoiBusiness
  | PoiGovernment
  | PoiMedical
  | PoiPark
  | PoiPlaceOfWorship
  | PoiSchool
  | PoiSportsComplex
  | Road
  | RoadArterial
  | RoadHighway
  | RoadHighwayControlledAccess
  | RoadLocal
  | Transit
  | TransitLine
  | TransitStation
  | TransitStationAirport
  | TransitStationBus
  | TransitStationRail
  | Water
  deriving (Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
/= :: Feature -> Feature -> Bool
Eq, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Feature -> ShowS
showsPrec :: Int -> Feature -> ShowS
$cshow :: Feature -> String
show :: Feature -> String
$cshowList :: [Feature] -> ShowS
showList :: [Feature] -> ShowS
Show)

instance ToHttpApiData Feature where
  toUrlPiece :: Feature -> Text
toUrlPiece Feature
feature = case Feature
feature of
    Feature
AllFeatures                 -> Text
"all"
    Feature
Administrative              -> Text
"administrative"
    Feature
AdministrativeCountry       -> Text
"administrative.country"
    Feature
AdministrativeLandParcel    -> Text
"administrative.land_parcel"
    Feature
AdministrativeLocality      -> Text
"administrative.locality"
    Feature
AdministrativeNeighborhood  -> Text
"administrative.neighborhood"
    Feature
AdministrativeProvince      -> Text
"administrative.province"
    Feature
Landscape                   -> Text
"landscape"
    Feature
LandscapeManMade            -> Text
"landscape.man_made"
    Feature
LandscapeNatural            -> Text
"landscape.natural"
    Feature
LandscapeNaturalLandcover   -> Text
"landscape.landcover"
    Feature
LandscapeNaturalTerrain     -> Text
"landscape.terrain"
    Feature
Poi                         -> Text
"poi"
    Feature
PoiAttraction               -> Text
"poi.attraction"
    Feature
PoiBusiness                 -> Text
"poi.business"
    Feature
PoiGovernment               -> Text
"poi.government"
    Feature
PoiMedical                  -> Text
"poi.medical"
    Feature
PoiPark                     -> Text
"poi.park"
    Feature
PoiPlaceOfWorship           -> Text
"poi.place_of_worship"
    Feature
PoiSchool                   -> Text
"poi.school"
    Feature
PoiSportsComplex            -> Text
"poi.sports_complex"
    Feature
Road                        -> Text
"road"
    Feature
RoadArterial                -> Text
"road.arterial"
    Feature
RoadHighway                 -> Text
"road.highway"
    Feature
RoadHighwayControlledAccess -> Text
"road.controlled_access"
    Feature
RoadLocal                   -> Text
"road.local"
    Feature
Transit                     -> Text
"transit"
    Feature
TransitLine                 -> Text
"transit.line"
    Feature
TransitStation              -> Text
"transit.station"
    Feature
TransitStationAirport       -> Text
"transit.station.airport"
    Feature
TransitStationBus           -> Text
"transit.station.bus"
    Feature
TransitStationRail          -> Text
"transit.station.rail"
    Feature
Water                       -> Text
"water"

-- | Feature element

data Element
  = AllElements
  | AllGeometry
  | GeometryFill
  | GeometryStroke
  | AllLabels
  | LabelsIcon
  | LabelsText
  | LabelsTextFill
  | LabelsTextStroke
  deriving (Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
/= :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show)

instance ToHttpApiData Element where
  toUrlPiece :: Element -> Text
toUrlPiece Element
element = case Element
element of
    Element
AllElements      -> Text
"all"
    Element
AllGeometry      -> Text
"geometry"
    Element
GeometryFill     -> Text
"geometry.fill"
    Element
GeometryStroke   -> Text
"geometry.stroke"
    Element
AllLabels        -> Text
"labels"
    Element
LabelsIcon       -> Text
"labels.icon"
    Element
LabelsText       -> Text
"labels.text"
    Element
LabelsTextFill   -> Text
"labels.text.fill"
    Element
LabelsTextStroke -> Text
"labels.text.stroke"

-- | Map style operation

data MapStyleOp
  = StyleHue Word8 Word8 Word8
  | StyleLightness Double
  | StyleSaturation Double
  | StyleGamma Double
  | StyleInvertLightness Bool
  | StyleVisibility Visibility
  | StyleColor Word8 Word8 Word8
  | StyleWeight Int
  deriving (MapStyleOp -> MapStyleOp -> Bool
(MapStyleOp -> MapStyleOp -> Bool)
-> (MapStyleOp -> MapStyleOp -> Bool) -> Eq MapStyleOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MapStyleOp -> MapStyleOp -> Bool
== :: MapStyleOp -> MapStyleOp -> Bool
$c/= :: MapStyleOp -> MapStyleOp -> Bool
/= :: MapStyleOp -> MapStyleOp -> Bool
Eq, Int -> MapStyleOp -> ShowS
[MapStyleOp] -> ShowS
MapStyleOp -> String
(Int -> MapStyleOp -> ShowS)
-> (MapStyleOp -> String)
-> ([MapStyleOp] -> ShowS)
-> Show MapStyleOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MapStyleOp -> ShowS
showsPrec :: Int -> MapStyleOp -> ShowS
$cshow :: MapStyleOp -> String
show :: MapStyleOp -> String
$cshowList :: [MapStyleOp] -> ShowS
showList :: [MapStyleOp] -> ShowS
Show)

instance ToHttpApiData MapStyleOp where
  toUrlPiece :: MapStyleOp -> Text
toUrlPiece MapStyleOp
mapStyleOp
    | StyleHue Word8
r Word8
g Word8
b <- MapStyleOp
mapStyleOp
      = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"hue:0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
    | StyleLightness Double
l <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"lightness:", Double -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
l]
    | StyleSaturation Double
s <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"saturation:", Double -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
s]
    | StyleGamma Double
g <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"gamma:", Double -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
g]
    | StyleInvertLightness Bool
i <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"invert_lightness:", Bool -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Bool
i]
    | StyleVisibility Visibility
e <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"visibility:", Visibility -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Visibility
e]
    | StyleColor Word8
r Word8
g Word8
b <- MapStyleOp
mapStyleOp
      = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"color:0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
    | StyleWeight Int
w <- MapStyleOp
mapStyleOp
      = [Text] -> Text
T.concat [Text
"weight:", Int -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Int
w]

instance ToHttpApiData [MapStyleOp] where
  toUrlPiece :: [MapStyleOp] -> Text
toUrlPiece [MapStyleOp]
ops = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (MapStyleOp -> Text) -> [MapStyleOp] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MapStyleOp -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [MapStyleOp]
ops

-- | Visibility

data Visibility
  = On
  | Off
  | Simplified  -- ^ Removes some, not all, style features

  deriving (Visibility -> Visibility -> Bool
(Visibility -> Visibility -> Bool)
-> (Visibility -> Visibility -> Bool) -> Eq Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
/= :: Visibility -> Visibility -> Bool
Eq, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Visibility -> ShowS
showsPrec :: Int -> Visibility -> ShowS
$cshow :: Visibility -> String
show :: Visibility -> String
$cshowList :: [Visibility] -> ShowS
showList :: [Visibility] -> ShowS
Show)

instance ToHttpApiData Visibility where
  toUrlPiece :: Visibility -> Text
toUrlPiece Visibility
visibility = case Visibility
visibility of
    Visibility
On         -> Text
"on"
    Visibility
Off        -> Text
"off"
    Visibility
Simplified -> Text
"simplified"

-- | Map type

data MapType
  = RoadMap    -- ^ The default value.

  | Satellite
  | Hybrid
  | Terrain
  deriving (MapType -> MapType -> Bool
(MapType -> MapType -> Bool)
-> (MapType -> MapType -> Bool) -> Eq MapType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MapType -> MapType -> Bool
== :: MapType -> MapType -> Bool
$c/= :: MapType -> MapType -> Bool
/= :: MapType -> MapType -> Bool
Eq, Int -> MapType -> ShowS
[MapType] -> ShowS
MapType -> String
(Int -> MapType -> ShowS)
-> (MapType -> String) -> ([MapType] -> ShowS) -> Show MapType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MapType -> ShowS
showsPrec :: Int -> MapType -> ShowS
$cshow :: MapType -> String
show :: MapType -> String
$cshowList :: [MapType] -> ShowS
showList :: [MapType] -> ShowS
Show)

instance ToHttpApiData MapType where
  toUrlPiece :: MapType -> Text
toUrlPiece MapType
mapType = case MapType
mapType of
    MapType
RoadMap   -> Text
"roadmap"
    MapType
Satellite -> Text
"satellite"
    MapType
Hybrid    -> Text
"hybrid"
    MapType
Terrain   -> Text
"terrain"

-- | Markers

data Markers = Markers (Maybe MarkerStyle) [Location]
  deriving (Markers -> Markers -> Bool
(Markers -> Markers -> Bool)
-> (Markers -> Markers -> Bool) -> Eq Markers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Markers -> Markers -> Bool
== :: Markers -> Markers -> Bool
$c/= :: Markers -> Markers -> Bool
/= :: Markers -> Markers -> Bool
Eq, Int -> Markers -> ShowS
[Markers] -> ShowS
Markers -> String
(Int -> Markers -> ShowS)
-> (Markers -> String) -> ([Markers] -> ShowS) -> Show Markers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Markers -> ShowS
showsPrec :: Int -> Markers -> ShowS
$cshow :: Markers -> String
show :: Markers -> String
$cshowList :: [Markers] -> ShowS
showList :: [Markers] -> ShowS
Show)

instance ToHttpApiData Markers where
  toUrlPiece :: Markers -> Text
toUrlPiece (Markers Maybe MarkerStyle
markerStyleOpt [Location]
ls)
    | Maybe MarkerStyle
Nothing <- Maybe MarkerStyle
markerStyleOpt
      = [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
    | Just (StdMarkerStyle Maybe MarkerSize
Nothing Maybe MarkerColor
Nothing Maybe MarkerLabel
Nothing) <- Maybe MarkerStyle
markerStyleOpt
      = [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
    | Just MarkerStyle
markerStyle <- Maybe MarkerStyle
markerStyleOpt
      = case [Location]
ls of
          [] -> MarkerStyle -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece MarkerStyle
markerStyle
          [Location]
_  -> [Text] -> Text
T.concat [MarkerStyle -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece MarkerStyle
markerStyle, Text
"|", [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls]

-- | Marker style

data MarkerStyle
  = StdMarkerStyle
      { MarkerStyle -> Maybe MarkerSize
markerSize  :: Maybe MarkerSize
      , MarkerStyle -> Maybe MarkerColor
markerColor :: Maybe MarkerColor
      , MarkerStyle -> Maybe MarkerLabel
markerLabel :: Maybe MarkerLabel
      }
  | CustomIcon
      { MarkerStyle -> URI
icon   :: URI
      , MarkerStyle -> Maybe Anchor
anchor :: Maybe Anchor
      }
  deriving (MarkerStyle -> MarkerStyle -> Bool
(MarkerStyle -> MarkerStyle -> Bool)
-> (MarkerStyle -> MarkerStyle -> Bool) -> Eq MarkerStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkerStyle -> MarkerStyle -> Bool
== :: MarkerStyle -> MarkerStyle -> Bool
$c/= :: MarkerStyle -> MarkerStyle -> Bool
/= :: MarkerStyle -> MarkerStyle -> Bool
Eq, Int -> MarkerStyle -> ShowS
[MarkerStyle] -> ShowS
MarkerStyle -> String
(Int -> MarkerStyle -> ShowS)
-> (MarkerStyle -> String)
-> ([MarkerStyle] -> ShowS)
-> Show MarkerStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkerStyle -> ShowS
showsPrec :: Int -> MarkerStyle -> ShowS
$cshow :: MarkerStyle -> String
show :: MarkerStyle -> String
$cshowList :: [MarkerStyle] -> ShowS
showList :: [MarkerStyle] -> ShowS
Show)

instance ToHttpApiData MarkerStyle where
  toUrlPiece :: MarkerStyle -> Text
toUrlPiece MarkerStyle
markerStyle
    | StdMarkerStyle Maybe MarkerSize
ms Maybe MarkerColor
mc Maybe MarkerLabel
ml <- MarkerStyle
markerStyle
      = let size' :: Maybe Text
size'  = Text -> Text -> Text
T.append Text
"size:" (Text -> Text) -> (MarkerSize -> Text) -> MarkerSize -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkerSize -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (MarkerSize -> Text) -> Maybe MarkerSize -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MarkerSize
ms
            color' :: Maybe Text
color' = Text -> Text -> Text
T.append Text
"color:" (Text -> Text) -> (MarkerColor -> Text) -> MarkerColor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkerColor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (MarkerColor -> Text) -> Maybe MarkerColor -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MarkerColor
mc
            label' :: Maybe Text
label' = Text -> Text -> Text
T.append Text
"label:" (Text -> Text) -> (MarkerLabel -> Text) -> MarkerLabel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkerLabel -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (MarkerLabel -> Text) -> Maybe MarkerLabel -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MarkerLabel
ml
            opts :: [Text]
opts   = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
size', Maybe Text
color', Maybe Text
label']
        in  [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" [Text]
opts
    | CustomIcon URI
url Maybe Anchor
ma <- MarkerStyle
markerStyle
      = let icon' :: Text
icon' = [Text] -> Text
T.concat [Text
"icon:", String -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
uriToString ShowS
forall a. a -> a
id URI
url String
""]
        in  case Maybe Anchor
ma of
              Maybe Anchor
Nothing -> Text
icon'
              Just Anchor
a -> [Text] -> Text
T.concat [Text
icon', Text
"|", Text
"anchor:", Anchor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece Anchor
a]

-- | Marker size

data MarkerSize
  = Tiny
  | Mid
  | Small
  deriving (MarkerSize -> MarkerSize -> Bool
(MarkerSize -> MarkerSize -> Bool)
-> (MarkerSize -> MarkerSize -> Bool) -> Eq MarkerSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkerSize -> MarkerSize -> Bool
== :: MarkerSize -> MarkerSize -> Bool
$c/= :: MarkerSize -> MarkerSize -> Bool
/= :: MarkerSize -> MarkerSize -> Bool
Eq, Int -> MarkerSize -> ShowS
[MarkerSize] -> ShowS
MarkerSize -> String
(Int -> MarkerSize -> ShowS)
-> (MarkerSize -> String)
-> ([MarkerSize] -> ShowS)
-> Show MarkerSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkerSize -> ShowS
showsPrec :: Int -> MarkerSize -> ShowS
$cshow :: MarkerSize -> String
show :: MarkerSize -> String
$cshowList :: [MarkerSize] -> ShowS
showList :: [MarkerSize] -> ShowS
Show)

instance ToHttpApiData MarkerSize where
  toUrlPiece :: MarkerSize -> Text
toUrlPiece MarkerSize
markerSize' = case MarkerSize
markerSize' of
    MarkerSize
Tiny  -> Text
"tiny"
    MarkerSize
Mid   -> Text
"mid"
    MarkerSize
Small -> Text
"small"

-- | Marker colour

data MarkerColor
  = MarkerColor Word8 Word8 Word8
  | StdMarkerColor StdColor
  deriving (MarkerColor -> MarkerColor -> Bool
(MarkerColor -> MarkerColor -> Bool)
-> (MarkerColor -> MarkerColor -> Bool) -> Eq MarkerColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkerColor -> MarkerColor -> Bool
== :: MarkerColor -> MarkerColor -> Bool
$c/= :: MarkerColor -> MarkerColor -> Bool
/= :: MarkerColor -> MarkerColor -> Bool
Eq, Int -> MarkerColor -> ShowS
[MarkerColor] -> ShowS
MarkerColor -> String
(Int -> MarkerColor -> ShowS)
-> (MarkerColor -> String)
-> ([MarkerColor] -> ShowS)
-> Show MarkerColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkerColor -> ShowS
showsPrec :: Int -> MarkerColor -> ShowS
$cshow :: MarkerColor -> String
show :: MarkerColor -> String
$cshowList :: [MarkerColor] -> ShowS
showList :: [MarkerColor] -> ShowS
Show)

instance ToHttpApiData MarkerColor where
  toUrlPiece :: MarkerColor -> Text
toUrlPiece (MarkerColor Word8
r Word8
g Word8
b) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
  toUrlPiece (StdMarkerColor StdColor
stdColor) = StdColor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece StdColor
stdColor

-- | Standard colours

data StdColor
  = Black
  | Brown
  | Green
  | Purple
  | Yellow
  | Blue
  | Gray
  | Orange
  | Red
  | White
  deriving (StdColor -> StdColor -> Bool
(StdColor -> StdColor -> Bool)
-> (StdColor -> StdColor -> Bool) -> Eq StdColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdColor -> StdColor -> Bool
== :: StdColor -> StdColor -> Bool
$c/= :: StdColor -> StdColor -> Bool
/= :: StdColor -> StdColor -> Bool
Eq, Int -> StdColor -> ShowS
[StdColor] -> ShowS
StdColor -> String
(Int -> StdColor -> ShowS)
-> (StdColor -> String) -> ([StdColor] -> ShowS) -> Show StdColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdColor -> ShowS
showsPrec :: Int -> StdColor -> ShowS
$cshow :: StdColor -> String
show :: StdColor -> String
$cshowList :: [StdColor] -> ShowS
showList :: [StdColor] -> ShowS
Show)

instance ToHttpApiData StdColor where
  toUrlPiece :: StdColor -> Text
toUrlPiece StdColor
stdColor = case StdColor
stdColor of
    StdColor
Black  -> Text
"black"
    StdColor
Brown  -> Text
"brown"
    StdColor
Green  -> Text
"green"
    StdColor
Purple -> Text
"purple"
    StdColor
Yellow -> Text
"yellow"
    StdColor
Blue   -> Text
"blue"
    StdColor
Gray   -> Text
"gray"
    StdColor
Orange -> Text
"orange"
    StdColor
Red    -> Text
"red"
    StdColor
White  -> Text
"white"

-- | Marker label character

newtype MarkerLabel = MarkerLabel Char
  deriving (MarkerLabel -> MarkerLabel -> Bool
(MarkerLabel -> MarkerLabel -> Bool)
-> (MarkerLabel -> MarkerLabel -> Bool) -> Eq MarkerLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkerLabel -> MarkerLabel -> Bool
== :: MarkerLabel -> MarkerLabel -> Bool
$c/= :: MarkerLabel -> MarkerLabel -> Bool
/= :: MarkerLabel -> MarkerLabel -> Bool
Eq, Int -> MarkerLabel -> ShowS
[MarkerLabel] -> ShowS
MarkerLabel -> String
(Int -> MarkerLabel -> ShowS)
-> (MarkerLabel -> String)
-> ([MarkerLabel] -> ShowS)
-> Show MarkerLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkerLabel -> ShowS
showsPrec :: Int -> MarkerLabel -> ShowS
$cshow :: MarkerLabel -> String
show :: MarkerLabel -> String
$cshowList :: [MarkerLabel] -> ShowS
showList :: [MarkerLabel] -> ShowS
Show, MarkerLabel -> ByteString
MarkerLabel -> Text
MarkerLabel -> Builder
(MarkerLabel -> Text)
-> (MarkerLabel -> Builder)
-> (MarkerLabel -> ByteString)
-> (MarkerLabel -> Text)
-> (MarkerLabel -> Builder)
-> ToHttpApiData MarkerLabel
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: MarkerLabel -> Text
toUrlPiece :: MarkerLabel -> Text
$ctoEncodedUrlPiece :: MarkerLabel -> Builder
toEncodedUrlPiece :: MarkerLabel -> Builder
$ctoHeader :: MarkerLabel -> ByteString
toHeader :: MarkerLabel -> ByteString
$ctoQueryParam :: MarkerLabel -> Text
toQueryParam :: MarkerLabel -> Text
$ctoEncodedQueryParam :: MarkerLabel -> Builder
toEncodedQueryParam :: MarkerLabel -> Builder
ToHttpApiData)

-- | Anchor

data Anchor
  = AnchorPoint Int Int
  | StdAnchor StdAnchor
  deriving (Anchor -> Anchor -> Bool
(Anchor -> Anchor -> Bool)
-> (Anchor -> Anchor -> Bool) -> Eq Anchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
/= :: Anchor -> Anchor -> Bool
Eq, Int -> Anchor -> ShowS
[Anchor] -> ShowS
Anchor -> String
(Int -> Anchor -> ShowS)
-> (Anchor -> String) -> ([Anchor] -> ShowS) -> Show Anchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Anchor -> ShowS
showsPrec :: Int -> Anchor -> ShowS
$cshow :: Anchor -> String
show :: Anchor -> String
$cshowList :: [Anchor] -> ShowS
showList :: [Anchor] -> ShowS
Show)

instance ToHttpApiData Anchor where
  toUrlPiece :: Anchor -> Text
toUrlPiece Anchor
anchor'
    | AnchorPoint Int
x Int
y <- Anchor
anchor'
      = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y)
    | StdAnchor StdAnchor
stdAnchor <- Anchor
anchor'
      = StdAnchor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece StdAnchor
stdAnchor

-- | Standard anchor points

data StdAnchor
  = AnchorTop
  | AnchorBottom
  | AnchorLeft
  | AnchorRight
  | AnchorCenter
  | AnchorTopLeft
  | AnchorTopRight
  | AnchorBottomLeft
  | AnchorBottomRight
  deriving (StdAnchor -> StdAnchor -> Bool
(StdAnchor -> StdAnchor -> Bool)
-> (StdAnchor -> StdAnchor -> Bool) -> Eq StdAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdAnchor -> StdAnchor -> Bool
== :: StdAnchor -> StdAnchor -> Bool
$c/= :: StdAnchor -> StdAnchor -> Bool
/= :: StdAnchor -> StdAnchor -> Bool
Eq, Int -> StdAnchor -> ShowS
[StdAnchor] -> ShowS
StdAnchor -> String
(Int -> StdAnchor -> ShowS)
-> (StdAnchor -> String)
-> ([StdAnchor] -> ShowS)
-> Show StdAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdAnchor -> ShowS
showsPrec :: Int -> StdAnchor -> ShowS
$cshow :: StdAnchor -> String
show :: StdAnchor -> String
$cshowList :: [StdAnchor] -> ShowS
showList :: [StdAnchor] -> ShowS
Show)

instance ToHttpApiData StdAnchor where
  toUrlPiece :: StdAnchor -> Text
toUrlPiece StdAnchor
stdAnchor = case StdAnchor
stdAnchor of
    StdAnchor
AnchorTop         -> Text
"top"
    StdAnchor
AnchorBottom      -> Text
"bottom"
    StdAnchor
AnchorLeft        -> Text
"left"
    StdAnchor
AnchorRight       -> Text
"right"
    StdAnchor
AnchorCenter      -> Text
"center"
    StdAnchor
AnchorTopLeft     -> Text
"topleft"
    StdAnchor
AnchorTopRight    -> Text
"topright"
    StdAnchor
AnchorBottomLeft  -> Text
"bottomleft"
    StdAnchor
AnchorBottomRight -> Text
"bottomright"

-- | Path

data Path = Path (Maybe PathStyle) [Location]
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)

instance ToHttpApiData Path where
  toUrlPiece :: Path -> Text
toUrlPiece (Path Maybe PathStyle
pathStyleOpt [Location]
ls)
    | Maybe PathStyle
Nothing <- Maybe PathStyle
pathStyleOpt
      = [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
    | Just (PathStyle Maybe PathWeight
Nothing Maybe PathColor
Nothing Maybe PathColor
Nothing Maybe PathGeodesic
Nothing) <- Maybe PathStyle
pathStyleOpt
      = [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
    | Just PathStyle
pathStyle <- Maybe PathStyle
pathStyleOpt
      = case [Location]
ls of
          [] -> PathStyle -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece PathStyle
pathStyle
          [Location]
_  -> [Text] -> Text
T.concat [PathStyle -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece PathStyle
pathStyle, Text
"|", [Location] -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls]

-- | Path style: a geodesic path follows the curvature of the Earth.

data PathStyle = PathStyle
  { PathStyle -> Maybe PathWeight
pathWeight     :: Maybe PathWeight    -- ^ The default value is 5.

  , PathStyle -> Maybe PathColor
pathColor      :: Maybe PathColor
  , PathStyle -> Maybe PathColor
pathFillColor  :: Maybe PathColor
  , PathStyle -> Maybe PathGeodesic
pathGeodesic   :: Maybe PathGeodesic  -- ^ The default value is false.

  } deriving (PathStyle -> PathStyle -> Bool
(PathStyle -> PathStyle -> Bool)
-> (PathStyle -> PathStyle -> Bool) -> Eq PathStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathStyle -> PathStyle -> Bool
== :: PathStyle -> PathStyle -> Bool
$c/= :: PathStyle -> PathStyle -> Bool
/= :: PathStyle -> PathStyle -> Bool
Eq, Int -> PathStyle -> ShowS
[PathStyle] -> ShowS
PathStyle -> String
(Int -> PathStyle -> ShowS)
-> (PathStyle -> String)
-> ([PathStyle] -> ShowS)
-> Show PathStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathStyle -> ShowS
showsPrec :: Int -> PathStyle -> ShowS
$cshow :: PathStyle -> String
show :: PathStyle -> String
$cshowList :: [PathStyle] -> ShowS
showList :: [PathStyle] -> ShowS
Show)

instance ToHttpApiData PathStyle where
  toUrlPiece :: PathStyle -> Text
toUrlPiece (PathStyle Maybe PathWeight
mw Maybe PathColor
mc Maybe PathColor
mfc Maybe PathGeodesic
mg) =
    [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"|" [Text]
opts
   where
    weightUrl :: Maybe Text
weightUrl    = Text -> Text -> Text
T.append Text
"weight:" (Text -> Text) -> (PathWeight -> Text) -> PathWeight -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathWeight -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (PathWeight -> Text) -> Maybe PathWeight -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathWeight
mw
    colorUrl :: Maybe Text
colorUrl     = Text -> Text -> Text
T.append Text
"color:" (Text -> Text) -> (PathColor -> Text) -> PathColor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathColor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (PathColor -> Text) -> Maybe PathColor -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathColor
mc
    fillColorUrl :: Maybe Text
fillColorUrl = Text -> Text -> Text
T.append Text
"fillcolor:" (Text -> Text) -> (PathColor -> Text) -> PathColor -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathColor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (PathColor -> Text) -> Maybe PathColor -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathColor
mfc
    geodesicUrl :: Maybe Text
geodesicUrl  = Text -> Text -> Text
T.append Text
"geodesic:" (Text -> Text) -> (PathGeodesic -> Text) -> PathGeodesic -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathGeodesic -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (PathGeodesic -> Text) -> Maybe PathGeodesic -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathGeodesic
mg
    opts :: [Text]
opts         = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
weightUrl, Maybe Text
colorUrl, Maybe Text
fillColorUrl, Maybe Text
geodesicUrl]

-- | Path weight: in pixels.

newtype PathWeight = PathWeight Int
  deriving (PathWeight -> PathWeight -> Bool
(PathWeight -> PathWeight -> Bool)
-> (PathWeight -> PathWeight -> Bool) -> Eq PathWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathWeight -> PathWeight -> Bool
== :: PathWeight -> PathWeight -> Bool
$c/= :: PathWeight -> PathWeight -> Bool
/= :: PathWeight -> PathWeight -> Bool
Eq, Int -> PathWeight -> ShowS
[PathWeight] -> ShowS
PathWeight -> String
(Int -> PathWeight -> ShowS)
-> (PathWeight -> String)
-> ([PathWeight] -> ShowS)
-> Show PathWeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathWeight -> ShowS
showsPrec :: Int -> PathWeight -> ShowS
$cshow :: PathWeight -> String
show :: PathWeight -> String
$cshowList :: [PathWeight] -> ShowS
showList :: [PathWeight] -> ShowS
Show, PathWeight -> ByteString
PathWeight -> Text
PathWeight -> Builder
(PathWeight -> Text)
-> (PathWeight -> Builder)
-> (PathWeight -> ByteString)
-> (PathWeight -> Text)
-> (PathWeight -> Builder)
-> ToHttpApiData PathWeight
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PathWeight -> Text
toUrlPiece :: PathWeight -> Text
$ctoEncodedUrlPiece :: PathWeight -> Builder
toEncodedUrlPiece :: PathWeight -> Builder
$ctoHeader :: PathWeight -> ByteString
toHeader :: PathWeight -> ByteString
$ctoQueryParam :: PathWeight -> Text
toQueryParam :: PathWeight -> Text
$ctoEncodedQueryParam :: PathWeight -> Builder
toEncodedQueryParam :: PathWeight -> Builder
ToHttpApiData)

-- | Path colour

data PathColor
  = PathColor Word8 Word8 Word8
  | PathColorAlpha Word8 Word8 Word8 Word8
  | StdPathColor StdColor
  deriving (PathColor -> PathColor -> Bool
(PathColor -> PathColor -> Bool)
-> (PathColor -> PathColor -> Bool) -> Eq PathColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathColor -> PathColor -> Bool
== :: PathColor -> PathColor -> Bool
$c/= :: PathColor -> PathColor -> Bool
/= :: PathColor -> PathColor -> Bool
Eq, Int -> PathColor -> ShowS
[PathColor] -> ShowS
PathColor -> String
(Int -> PathColor -> ShowS)
-> (PathColor -> String)
-> ([PathColor] -> ShowS)
-> Show PathColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathColor -> ShowS
showsPrec :: Int -> PathColor -> ShowS
$cshow :: PathColor -> String
show :: PathColor -> String
$cshowList :: [PathColor] -> ShowS
showList :: [PathColor] -> ShowS
Show)

instance ToHttpApiData PathColor where
  toUrlPiece :: PathColor -> Text
toUrlPiece (PathColor Word8
r Word8
g Word8
b) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
  toUrlPiece (PathColorAlpha Word8
r Word8
g Word8
b Word8
a) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"0x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r String -> ShowS
forall a. [a] -> [a] -> [a]
++
    Word8 -> String
hexString Word8
g String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
a
  toUrlPiece (StdPathColor StdColor
stdColor) = StdColor -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece StdColor
stdColor

-- | Path is geodesic

newtype PathGeodesic = PathGeodesic Bool
  deriving (PathGeodesic -> PathGeodesic -> Bool
(PathGeodesic -> PathGeodesic -> Bool)
-> (PathGeodesic -> PathGeodesic -> Bool) -> Eq PathGeodesic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathGeodesic -> PathGeodesic -> Bool
== :: PathGeodesic -> PathGeodesic -> Bool
$c/= :: PathGeodesic -> PathGeodesic -> Bool
/= :: PathGeodesic -> PathGeodesic -> Bool
Eq, Int -> PathGeodesic -> ShowS
[PathGeodesic] -> ShowS
PathGeodesic -> String
(Int -> PathGeodesic -> ShowS)
-> (PathGeodesic -> String)
-> ([PathGeodesic] -> ShowS)
-> Show PathGeodesic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathGeodesic -> ShowS
showsPrec :: Int -> PathGeodesic -> ShowS
$cshow :: PathGeodesic -> String
show :: PathGeodesic -> String
$cshowList :: [PathGeodesic] -> ShowS
showList :: [PathGeodesic] -> ShowS
Show, PathGeodesic -> ByteString
PathGeodesic -> Text
PathGeodesic -> Builder
(PathGeodesic -> Text)
-> (PathGeodesic -> Builder)
-> (PathGeodesic -> ByteString)
-> (PathGeodesic -> Text)
-> (PathGeodesic -> Builder)
-> ToHttpApiData PathGeodesic
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: PathGeodesic -> Text
toUrlPiece :: PathGeodesic -> Text
$ctoEncodedUrlPiece :: PathGeodesic -> Builder
toEncodedUrlPiece :: PathGeodesic -> Builder
$ctoHeader :: PathGeodesic -> ByteString
toHeader :: PathGeodesic -> ByteString
$ctoQueryParam :: PathGeodesic -> Text
toQueryParam :: PathGeodesic -> Text
$ctoEncodedQueryParam :: PathGeodesic -> Builder
toEncodedQueryParam :: PathGeodesic -> Builder
ToHttpApiData)

-- | Visible locations

newtype Visible = Visible [Location]
  deriving (Visible -> Visible -> Bool
(Visible -> Visible -> Bool)
-> (Visible -> Visible -> Bool) -> Eq Visible
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Visible -> Visible -> Bool
== :: Visible -> Visible -> Bool
$c/= :: Visible -> Visible -> Bool
/= :: Visible -> Visible -> Bool
Eq, Int -> Visible -> ShowS
[Visible] -> ShowS
Visible -> String
(Int -> Visible -> ShowS)
-> (Visible -> String) -> ([Visible] -> ShowS) -> Show Visible
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Visible -> ShowS
showsPrec :: Int -> Visible -> ShowS
$cshow :: Visible -> String
show :: Visible -> String
$cshowList :: [Visible] -> ShowS
showList :: [Visible] -> ShowS
Show, Visible -> ByteString
Visible -> Text
Visible -> Builder
(Visible -> Text)
-> (Visible -> Builder)
-> (Visible -> ByteString)
-> (Visible -> Text)
-> (Visible -> Builder)
-> ToHttpApiData Visible
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Visible -> Text
toUrlPiece :: Visible -> Text
$ctoEncodedUrlPiece :: Visible -> Builder
toEncodedUrlPiece :: Visible -> Builder
$ctoHeader :: Visible -> ByteString
toHeader :: Visible -> ByteString
$ctoQueryParam :: Visible -> Text
toQueryParam :: Visible -> Text
$ctoEncodedQueryParam :: Visible -> Builder
toEncodedQueryParam :: Visible -> Builder
ToHttpApiData)

-- | Google Maps Static API

type GoogleMapsStaticAPI
  =  "staticmap"
  :> QueryParam  "key"       Key
  :> QueryParam  "center"    Center
  :> QueryParam  "zoom"      Zoom
  :> QueryParam  "size"      Size
  :> QueryParam  "scale"     Scale
  :> QueryParam  "format"    Format
  :> QueryParams "style"     MapStyle
  :> QueryParam  "maptype"   MapType
  :> QueryParam  "language"  Language
  :> QueryParam  "region"    Region
  :> QueryParams "markers"   Markers
  :> QueryParams "path"      Path
  :> QueryParam  "visible"   Visible
  :> QueryParam  "signature" Signature
  :> Get '[PNG] StaticmapResponse

-- | StaticmapResponse

type StaticmapResponse = DynamicImage

-- | API type

api :: Proxy GoogleMapsStaticAPI
api :: Proxy GoogleMapsStaticAPI
api = Proxy GoogleMapsStaticAPI
forall {k} (t :: k). Proxy t
Proxy

staticmap' ::
     Maybe Key
  -> Maybe Center
  -> Maybe Zoom
  -> Maybe Size
  -> Maybe Scale
  -> Maybe Format
  -> [MapStyle]
  -> Maybe MapType
  -> Maybe Language
  -> Maybe Region
  -> [Markers]
  -> [Path]
  -> Maybe Visible
  -> Maybe Signature
  -> ClientM StaticmapResponse
staticmap' :: Maybe Key
-> Maybe Center
-> Maybe Zoom
-> Maybe Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> Maybe Signature
-> ClientM StaticmapResponse
staticmap' = Proxy GoogleMapsStaticAPI -> Client ClientM GoogleMapsStaticAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy GoogleMapsStaticAPI
api

-- | Retrieve a static map. NB: The use of the Google Maps Static API services

-- is subject to the

-- <https://cloud.google.com/maps-platform/terms/ Google Maps Platform Terms of Service>.

-- End Users' use of Google Maps is subject to the then-current Google

-- Maps/Google Earth Additional Terms of Service at

-- <https://maps.google.com/help/terms_maps.html> and Google Privacy Policy at

-- <https://www.google.com/policies/privacy/>.

staticmap ::
     Manager
  -> Key
  -> Maybe Secret
  -> Maybe Center
  -> Maybe Zoom
  -> Size
  -> Maybe Scale
  -> Maybe Format
  -> [MapStyle]
  -> Maybe MapType
  -> Maybe Language
  -> Maybe Region
  -> [Markers]
  -> [Path]
  -> Maybe Visible
  -> IO (Either ClientError StaticmapResponse)
staticmap :: Manager
-> Key
-> Maybe Secret
-> Maybe Center
-> Maybe Zoom
-> Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> IO (Either ClientError StaticmapResponse)
staticmap
  Manager
mgr
  Key
key
  Maybe Secret
secretOpt
  Maybe Center
centerOpt
  Maybe Zoom
zoomOpt
  Size
size
  Maybe Scale
scaleOpt
  Maybe Format
formatOpt
  [MapStyle]
mapStyles
  Maybe MapType
mapTypeOpt
  Maybe Language
languageOpt
  Maybe Region
regionOpt
  [Markers]
markerss
  [Path]
paths
  Maybe Visible
visibleOpt
  = case Maybe Secret
secretOpt of
      Maybe Secret
Nothing -> ClientM StaticmapResponse
-> ClientEnv -> IO (Either ClientError StaticmapResponse)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ((Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> Maybe Signature
 -> ClientM StaticmapResponse)
-> Maybe Signature -> ClientM StaticmapResponse
forall {t}.
(Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> t)
-> t
eval Maybe Key
-> Maybe Center
-> Maybe Zoom
-> Maybe Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> Maybe Signature
-> ClientM StaticmapResponse
staticmap' Maybe Signature
forall a. Maybe a
Nothing)
-- Middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
                            (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr
                                       BaseUrl
googleMapsApis
                                       Maybe (TVar CookieJar)
forall a. Maybe a
Nothing
                                       BaseUrl -> Request -> IO Request
defaultMakeClientRequest
                                       ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
                            (ClientEnv mgr
                                       googleMapsApis
                                       Nothing
                                       defaultMakeClientRequest)
-- CookieJar supported from servant-client-0.13

#elif MIN_VERSION_servant_client(0,13,0)
                            (ClientEnv mgr googleMapsApis Nothing)
#else
                            (ClientEnv mgr googleMapsApis)
#endif
      Just Secret
secret -> do
        let url :: URI
url = Link -> URI
linkURI (Link -> URI) -> Link -> URI
forall a b. (a -> b) -> a -> b
$ (Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> Maybe Signature
 -> Link)
-> Maybe Signature -> Link
forall {t}.
(Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> t)
-> t
eval (Proxy GoogleMapsStaticAPI
-> Proxy GoogleMapsStaticAPI -> MkLink GoogleMapsStaticAPI Link
forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink Proxy GoogleMapsStaticAPI
api Proxy GoogleMapsStaticAPI
api) Maybe Signature
forall a. Maybe a
Nothing
            signatureOpt :: Maybe Signature
signatureOpt = Secret -> BaseUrl -> URI -> Maybe Signature
sign Secret
secret BaseUrl
googleMapsApis URI
url
        ClientM StaticmapResponse
-> ClientEnv -> IO (Either ClientError StaticmapResponse)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ((Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> Maybe Signature
 -> ClientM StaticmapResponse)
-> Maybe Signature -> ClientM StaticmapResponse
forall {t}.
(Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> t)
-> t
eval Maybe Key
-> Maybe Center
-> Maybe Zoom
-> Maybe Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> Maybe Signature
-> ClientM StaticmapResponse
staticmap' Maybe Signature
signatureOpt)
-- Middleware supported from servant-client-0.20.2

#if MIN_VERSION_servant_client(0,20,2)
                   (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> IO Request)
-> ClientMiddleware
-> ClientEnv
ClientEnv Manager
mgr
                              BaseUrl
googleMapsApis
                              Maybe (TVar CookieJar)
forall a. Maybe a
Nothing
                              BaseUrl -> Request -> IO Request
defaultMakeClientRequest
                              ClientMiddleware
forall a. a -> a
id)
-- makeClientRequest supported from servant-client-0.17

#elif MIN_VERSION_servant_client(0,17,0)
                   (ClientEnv mgr
                              googleMapsApis
                              Nothing
                              defaultMakeClientRequest)
-- CookieJar supported from servant-client-0.13

#elif MIN_VERSION_servant_client(0,13,0)
                   (ClientEnv mgr googleMapsApis Nothing)
#else
                   (ClientEnv mgr googleMapsApis)
#endif
 where
  linkURI :: Link -> URI
linkURI = LinkArrayElementStyle -> Link -> URI
linkURI' LinkArrayElementStyle
LinkArrayElementPlain
  eval :: (Maybe Key
 -> Maybe Center
 -> Maybe Zoom
 -> Maybe Size
 -> Maybe Scale
 -> Maybe Format
 -> [MapStyle]
 -> Maybe MapType
 -> Maybe Language
 -> Maybe Region
 -> [Markers]
 -> [Path]
 -> Maybe Visible
 -> t)
-> t
eval Maybe Key
-> Maybe Center
-> Maybe Zoom
-> Maybe Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> t
f = Maybe Key
-> Maybe Center
-> Maybe Zoom
-> Maybe Size
-> Maybe Scale
-> Maybe Format
-> [MapStyle]
-> Maybe MapType
-> Maybe Language
-> Maybe Region
-> [Markers]
-> [Path]
-> Maybe Visible
-> t
f (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
key) Maybe Center
centerOpt Maybe Zoom
zoomOpt (Size -> Maybe Size
forall a. a -> Maybe a
Just Size
size) Maybe Scale
scaleOpt Maybe Format
formatOpt
             [MapStyle]
mapStyles Maybe MapType
mapTypeOpt Maybe Language
languageOpt Maybe Region
regionOpt [Markers]
markerss [Path]
paths
             Maybe Visible
visibleOpt

sign :: Secret -> BaseUrl -> URI -> Maybe Signature
sign :: Secret -> BaseUrl -> URI -> Maybe Signature
sign (Secret Text
secret) BaseUrl
baseUrl URI
url = do
  ByteString
secret' <- (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Either String ByteString
decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
secret)
  let url' :: ByteString
url'       = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ BaseUrl -> String
baseUrlPath BaseUrl
baseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> URI -> ShowS
uriToString ShowS
forall a. a -> a
id URI
url String
""
      signature :: HMAC SHA1
signature  = ByteString -> ByteString -> HMAC SHA1
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
secret' ByteString
url' :: HMAC SHA1
      signature' :: Text
signature' = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HMAC SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HMAC SHA1
signature
  Signature -> Maybe Signature
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Signature -> Maybe Signature) -> Signature -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ Text -> Signature
Signature Text
signature'