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

-- 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/intro 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Secret -> Secret -> Bool
$c/= :: Secret -> Secret -> Bool
== :: Secret -> Secret -> Bool
$c== :: Secret -> Secret -> Bool
Eq, Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Secret] -> ShowS
$cshowList :: [Secret] -> ShowS
show :: Secret -> String
$cshow :: Secret -> String
showsPrec :: Int -> Secret -> ShowS
$cshowsPrec :: Int -> Secret -> ShowS
Show)

-- | Signature

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

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

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

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

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

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

-- | Scale

data Scale
    = Single     -- ^ The default value.

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

instance ToHttpApiData MapStyle where
    toUrlPiece :: MapStyle -> Text
toUrlPiece (MapStyle Maybe Feature
featureOpt Maybe Element
elementOpt [MapStyleOp]
ops) =
        [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Text
"|" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
featureUrl, Maybe Text
elementUrl] forall a. [a] -> [a] -> [a]
++
            [Text
opsUrl]
      where
        featureUrl :: Maybe Text
featureUrl = Text -> Text -> Text
T.append Text
"feature:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Element
elementOpt
        opsUrl :: Text
opsUrl = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapStyleOp -> MapStyleOp -> Bool
$c/= :: MapStyleOp -> MapStyleOp -> Bool
== :: MapStyleOp -> MapStyleOp -> Bool
$c== :: MapStyleOp -> MapStyleOp -> Bool
Eq, Int -> MapStyleOp -> ShowS
[MapStyleOp] -> ShowS
MapStyleOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapStyleOp] -> ShowS
$cshowList :: [MapStyleOp] -> ShowS
show :: MapStyleOp -> String
$cshow :: MapStyleOp -> String
showsPrec :: Int -> MapStyleOp -> ShowS
$cshowsPrec :: Int -> 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 forall a b. (a -> b) -> a -> b
$ String
"hue:0x" forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
        | StyleLightness Double
l <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"lightness:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
l]
        | StyleSaturation Double
s <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"saturation:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
s]
        | StyleGamma Double
g <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"gamma:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Double
g]
        | StyleInvertLightness Bool
i <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"invert_lightness:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Bool
i]
        | StyleVisibility Visibility
e <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"visibility:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Visibility
e]
        | StyleColor Word8
r Word8
g Word8
b <- MapStyleOp
mapStyleOp
          = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"color:0x" forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
        | StyleWeight Int
w <- MapStyleOp
mapStyleOp
          = [Text] -> Text
T.concat [Text
"weight:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Int
w]

instance ToHttpApiData [MapStyleOp] where
    toUrlPiece :: [MapStyleOp] -> Text
toUrlPiece [MapStyleOp]
ops = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Text
"|" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visibility -> Visibility -> Bool
$c/= :: Visibility -> Visibility -> Bool
== :: Visibility -> Visibility -> Bool
$c== :: Visibility -> Visibility -> Bool
Eq, Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visibility] -> ShowS
$cshowList :: [Visibility] -> ShowS
show :: Visibility -> String
$cshow :: Visibility -> String
showsPrec :: Int -> Visibility -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MapType -> MapType -> Bool
$c/= :: MapType -> MapType -> Bool
== :: MapType -> MapType -> Bool
$c== :: MapType -> MapType -> Bool
Eq, Int -> MapType -> ShowS
[MapType] -> ShowS
MapType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MapType] -> ShowS
$cshowList :: [MapType] -> ShowS
show :: MapType -> String
$cshow :: MapType -> String
showsPrec :: Int -> MapType -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markers -> Markers -> Bool
$c/= :: Markers -> Markers -> Bool
== :: Markers -> Markers -> Bool
$c== :: Markers -> Markers -> Bool
Eq, Int -> Markers -> ShowS
[Markers] -> ShowS
Markers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Markers] -> ShowS
$cshowList :: [Markers] -> ShowS
show :: Markers -> String
$cshow :: Markers -> String
showsPrec :: Int -> Markers -> ShowS
$cshowsPrec :: Int -> Markers -> ShowS
Show)

instance ToHttpApiData Markers where
    toUrlPiece :: Markers -> Text
toUrlPiece (Markers Maybe MarkerStyle
markerStyleOpt [Location]
ls)
        | Maybe MarkerStyle
Nothing <- Maybe MarkerStyle
markerStyleOpt
          = forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
        | Just (StdMarkerStyle Maybe MarkerSize
Nothing Maybe MarkerColor
Nothing Maybe MarkerLabel
Nothing) <- Maybe MarkerStyle
markerStyleOpt
          = forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
        | Just MarkerStyle
markerStyle <- Maybe MarkerStyle
markerStyleOpt
          = case [Location]
ls of
                [] -> forall a. ToHttpApiData a => a -> Text
toUrlPiece MarkerStyle
markerStyle
                [Location]
_  -> [Text] -> Text
T.concat [forall a. ToHttpApiData a => a -> Text
toUrlPiece MarkerStyle
markerStyle, 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkerStyle -> MarkerStyle -> Bool
$c/= :: MarkerStyle -> MarkerStyle -> Bool
== :: MarkerStyle -> MarkerStyle -> Bool
$c== :: MarkerStyle -> MarkerStyle -> Bool
Eq, Int -> MarkerStyle -> ShowS
[MarkerStyle] -> ShowS
MarkerStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkerStyle] -> ShowS
$cshowList :: [MarkerStyle] -> ShowS
show :: MarkerStyle -> String
$cshow :: MarkerStyle -> String
showsPrec :: Int -> MarkerStyle -> ShowS
$cshowsPrec :: Int -> 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MarkerLabel
ml
                opts :: [Text]
opts     = forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
size', Maybe Text
color', Maybe Text
label']
            in  [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ 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:", forall a. ToHttpApiData a => a -> Text
toUrlPiece forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
uriToString 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:", forall a. ToHttpApiData a => a -> Text
toUrlPiece Anchor
a]

-- | Marker size

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

instance ToHttpApiData MarkerColor where
    toUrlPiece :: MarkerColor -> Text
toUrlPiece (MarkerColor Word8
r Word8
g Word8
b) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"0x" forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
r forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
g
        forall a. [a] -> [a] -> [a]
++ Word8 -> String
hexString Word8
b
    toUrlPiece (StdMarkerColor StdColor
stdColor) = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StdColor -> StdColor -> Bool
$c/= :: StdColor -> StdColor -> Bool
== :: StdColor -> StdColor -> Bool
$c== :: StdColor -> StdColor -> Bool
Eq, Int -> StdColor -> ShowS
[StdColor] -> ShowS
StdColor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StdColor] -> ShowS
$cshowList :: [StdColor] -> ShowS
show :: StdColor -> String
$cshow :: StdColor -> String
showsPrec :: Int -> StdColor -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkerLabel -> MarkerLabel -> Bool
$c/= :: MarkerLabel -> MarkerLabel -> Bool
== :: MarkerLabel -> MarkerLabel -> Bool
$c== :: MarkerLabel -> MarkerLabel -> Bool
Eq, Int -> MarkerLabel -> ShowS
[MarkerLabel] -> ShowS
MarkerLabel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkerLabel] -> ShowS
$cshowList :: [MarkerLabel] -> ShowS
show :: MarkerLabel -> String
$cshow :: MarkerLabel -> String
showsPrec :: Int -> MarkerLabel -> ShowS
$cshowsPrec :: Int -> MarkerLabel -> ShowS
Show, MarkerLabel -> ByteString
MarkerLabel -> Builder
MarkerLabel -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: MarkerLabel -> Text
$ctoQueryParam :: MarkerLabel -> Text
toHeader :: MarkerLabel -> ByteString
$ctoHeader :: MarkerLabel -> ByteString
toEncodedUrlPiece :: MarkerLabel -> Builder
$ctoEncodedUrlPiece :: MarkerLabel -> Builder
toUrlPiece :: MarkerLabel -> Text
$ctoUrlPiece :: MarkerLabel -> Text
ToHttpApiData)

-- | Anchor

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

instance ToHttpApiData Anchor where
    toUrlPiece :: Anchor -> Text
toUrlPiece Anchor
anchor'
        | AnchorPoint Int
x Int
y <- Anchor
anchor'
          = String -> Text
T.pack (forall a. Show a => a -> String
show Int
x forall a. [a] -> [a] -> [a]
++ String
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
y)
        | StdAnchor StdAnchor
stdAnchor <- Anchor
anchor'
          = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StdAnchor -> StdAnchor -> Bool
$c/= :: StdAnchor -> StdAnchor -> Bool
== :: StdAnchor -> StdAnchor -> Bool
$c== :: StdAnchor -> StdAnchor -> Bool
Eq, Int -> StdAnchor -> ShowS
[StdAnchor] -> ShowS
StdAnchor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StdAnchor] -> ShowS
$cshowList :: [StdAnchor] -> ShowS
show :: StdAnchor -> String
$cshow :: StdAnchor -> String
showsPrec :: Int -> StdAnchor -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)

instance ToHttpApiData Path where
    toUrlPiece :: Path -> Text
toUrlPiece (Path Maybe PathStyle
pathStyleOpt [Location]
ls)
        | Maybe PathStyle
Nothing <- Maybe PathStyle
pathStyleOpt
          = 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
          = forall a. ToHttpApiData a => a -> Text
toUrlPiece [Location]
ls
        | Just PathStyle
pathStyle <- Maybe PathStyle
pathStyleOpt
          = case [Location]
ls of
                [] -> forall a. ToHttpApiData a => a -> Text
toUrlPiece PathStyle
pathStyle
                [Location]
_  -> [Text] -> Text
T.concat [forall a. ToHttpApiData a => a -> Text
toUrlPiece PathStyle
pathStyle, 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathStyle -> PathStyle -> Bool
$c/= :: PathStyle -> PathStyle -> Bool
== :: PathStyle -> PathStyle -> Bool
$c== :: PathStyle -> PathStyle -> Bool
Eq, Int -> PathStyle -> ShowS
[PathStyle] -> ShowS
PathStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathStyle] -> ShowS
$cshowList :: [PathStyle] -> ShowS
show :: PathStyle -> String
$cshow :: PathStyle -> String
showsPrec :: Int -> PathStyle -> ShowS
$cshowsPrec :: Int -> 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Text
"|" [Text]
opts
      where
        weightUrl :: Maybe Text
weightUrl    = Text -> Text -> Text
T.append Text
"weight:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece 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:" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToHttpApiData a => a -> Text
toUrlPiece forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PathGeodesic
mg
        opts :: [Text]
opts         = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathWeight -> PathWeight -> Bool
$c/= :: PathWeight -> PathWeight -> Bool
== :: PathWeight -> PathWeight -> Bool
$c== :: PathWeight -> PathWeight -> Bool
Eq, Int -> PathWeight -> ShowS
[PathWeight] -> ShowS
PathWeight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathWeight] -> ShowS
$cshowList :: [PathWeight] -> ShowS
show :: PathWeight -> String
$cshow :: PathWeight -> String
showsPrec :: Int -> PathWeight -> ShowS
$cshowsPrec :: Int -> PathWeight -> ShowS
Show, PathWeight -> ByteString
PathWeight -> Builder
PathWeight -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: PathWeight -> Text
$ctoQueryParam :: PathWeight -> Text
toHeader :: PathWeight -> ByteString
$ctoHeader :: PathWeight -> ByteString
toEncodedUrlPiece :: PathWeight -> Builder
$ctoEncodedUrlPiece :: PathWeight -> Builder
toUrlPiece :: PathWeight -> Text
$ctoUrlPiece :: PathWeight -> Text
ToHttpApiData)

-- | Path colour

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

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

-- | Path is geodesic

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

-- | Visible locations

newtype Visible = Visible [Location]
    deriving (Visible -> Visible -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Visible -> Visible -> Bool
$c/= :: Visible -> Visible -> Bool
== :: Visible -> Visible -> Bool
$c== :: Visible -> Visible -> Bool
Eq, Int -> Visible -> ShowS
[Visible] -> ShowS
Visible -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Visible] -> ShowS
$cshowList :: [Visible] -> ShowS
show :: Visible -> String
$cshow :: Visible -> String
showsPrec :: Int -> Visible -> ShowS
$cshowsPrec :: Int -> Visible -> ShowS
Show, Visible -> ByteString
Visible -> Builder
Visible -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Visible -> Text
$ctoQueryParam :: Visible -> Text
toHeader :: Visible -> ByteString
$ctoHeader :: Visible -> ByteString
toEncodedUrlPiece :: Visible -> Builder
$ctoEncodedUrlPiece :: Visible -> Builder
toUrlPiece :: Visible -> Text
$ctoUrlPiece :: Visible -> Text
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 = 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' = 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 -> forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (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' forall a. Maybe a
Nothing)
-- makeClientRequest supported from servant-client-0.17

#if MIN_VERSION_servant_client(0,17,0)
                                (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> Request)
-> ClientEnv
ClientEnv Manager
mgr
                                           BaseUrl
googleMapsApis
                                           forall a. Maybe a
Nothing
                                           BaseUrl -> Request -> Request
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 forall a b. (a -> b) -> a -> b
$ 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 (forall endpoint api.
(IsElem endpoint api, HasLink endpoint) =>
Proxy api -> Proxy endpoint -> MkLink endpoint Link
safeLink Proxy GoogleMapsStaticAPI
api Proxy GoogleMapsStaticAPI
api) forall a. Maybe a
Nothing
                  signatureOpt :: Maybe Signature
signatureOpt = Secret -> BaseUrl -> URI -> Maybe Signature
sign Secret
secret BaseUrl
googleMapsApis URI
url
              forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (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)
-- makeClientRequest supported from servant-client-0.17

#if MIN_VERSION_servant_client(0,17,0)
                         (Manager
-> BaseUrl
-> Maybe (TVar CookieJar)
-> (BaseUrl -> Request -> Request)
-> ClientEnv
ClientEnv Manager
mgr
                                    BaseUrl
googleMapsApis
                                    forall a. Maybe a
Nothing
                                    BaseUrl -> Request -> Request
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 (forall a. a -> Maybe a
Just Key
key) Maybe Center
centerOpt Maybe Zoom
zoomOpt (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' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just (ByteString -> Either String ByteString
decode forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
secret)
    let url' :: ByteString
url'       = String -> ByteString
UTF8.fromString forall a b. (a -> b) -> a -> b
$ BaseUrl -> String
baseUrlPath BaseUrl
baseUrl forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ ShowS -> URI -> ShowS
uriToString forall a. a -> a
id URI
url String
""
        signature :: HMAC SHA1
signature  = 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 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert HMAC SHA1
signature
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Signature
Signature Text
signature'