google-static-maps-0.7.0.0: Bindings to the Google Maps Static API (formerly Static Maps API)
Copyright(c) Mike Pilgrem 2017 2018
Maintainerpublic@pilgrem.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Web.Google.Maps.Static

Description

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

The 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 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
Synopsis

Functions

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

Retrieve a static map. NB: The use of the Google Maps Static API services is subject to the 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/.

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

Google Maps Static API

Types

newtype Key Source #

API key

Constructors

Key Text 

Instances

Instances details
Eq Key Source # 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Key -> Key -> Bool #

(/=) :: Key -> Key -> Bool #

Show Key Source # 
Instance details

Defined in Web.Google.Maps.Common

Methods

showsPrec :: Int -> Key -> ShowS #

show :: Key -> String #

showList :: [Key] -> ShowS #

ToHttpApiData Key Source # 
Instance details

Defined in Web.Google.Maps.Common

newtype Secret Source #

Secret for digital signature

Constructors

Secret Text 

Instances

Instances details
Eq Secret Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Secret -> Secret -> Bool #

(/=) :: Secret -> Secret -> Bool #

Show Secret Source # 
Instance details

Defined in Web.Google.Maps.Static

newtype Signature Source #

Signature

Constructors

Signature Text 

newtype Center Source #

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

Constructors

Center Location 

Instances

Instances details
Eq Center Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Center -> Center -> Bool #

(/=) :: Center -> Center -> Bool #

Show Center Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData Center Source # 
Instance details

Defined in Web.Google.Maps.Static

data LatLng Source #

Latitude and longitude: precision beyond 6 decimal places is ignored.

Constructors

LatLng 

Fields

  • lat :: Double

    Takes any value between -90 and 90.

  • lng :: Double

    Takes any value between -180 and 180.

Instances

Instances details
Eq LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: LatLng -> LatLng -> Bool #

(/=) :: LatLng -> LatLng -> Bool #

Show LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

Generic LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

Associated Types

type Rep LatLng :: Type -> Type #

Methods

from :: LatLng -> Rep LatLng x #

to :: Rep LatLng x -> LatLng #

FromJSON LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

type Rep LatLng Source # 
Instance details

Defined in Web.Google.Maps.Common

type Rep LatLng = D1 ('MetaData "LatLng" "Web.Google.Maps.Common" "google-static-maps-0.7.0.0-I2JsPqt1xEw4jGQr8bBa21" 'False) (C1 ('MetaCons "LatLng" 'PrefixI 'True) (S1 ('MetaSel ('Just "lat") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double) :*: S1 ('MetaSel ('Just "lng") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Double)))

newtype Address Source #

Address

Constructors

Address Text 

Instances

Instances details
Eq Address Source # 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Address -> Address -> Bool #

(/=) :: Address -> Address -> Bool #

Show Address Source # 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Address Source # 
Instance details

Defined in Web.Google.Maps.Common

newtype Zoom Source #

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.

Constructors

Zoom Int 

Instances

Instances details
Eq Zoom Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Zoom -> Zoom -> Bool #

(/=) :: Zoom -> Zoom -> Bool #

Show Zoom Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

showsPrec :: Int -> Zoom -> ShowS #

show :: Zoom -> String #

showList :: [Zoom] -> ShowS #

ToHttpApiData Zoom Source # 
Instance details

Defined in Web.Google.Maps.Static

data Size Source #

Size in pixels: there are maximum allowable values.

Constructors

Size 

Fields

Instances

Instances details
Eq Size Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Size -> Size -> Bool #

(/=) :: Size -> Size -> Bool #

Show Size Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

showsPrec :: Int -> Size -> ShowS #

show :: Size -> String #

showList :: [Size] -> ShowS #

ToHttpApiData Size Source # 
Instance details

Defined in Web.Google.Maps.Static

data Scale Source #

Scale

Constructors

Single

The default value.

Double 
Quadruple 

Instances

Instances details
Eq Scale Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Scale -> Scale -> Bool #

(/=) :: Scale -> Scale -> Bool #

Show Scale Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

showsPrec :: Int -> Scale -> ShowS #

show :: Scale -> String #

showList :: [Scale] -> ShowS #

ToHttpApiData Scale Source # 
Instance details

Defined in Web.Google.Maps.Static

data Format Source #

Image format

Constructors

Png8

The default value.

Png32 

Instances

Instances details
Eq Format Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Format -> Format -> Bool #

(/=) :: Format -> Format -> Bool #

Show Format Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData Format Source # 
Instance details

Defined in Web.Google.Maps.Static

data MapStyle Source #

MapStyle

Instances

Instances details
Eq MapStyle Source # 
Instance details

Defined in Web.Google.Maps.Static

Show MapStyle Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData MapStyle Source # 
Instance details

Defined in Web.Google.Maps.Static

data Visibility Source #

Visibility

Constructors

On 
Off 
Simplified

Removes some, not all, style features

data MapType Source #

Map type

Constructors

RoadMap

The default value.

Satellite 
Hybrid 
Terrain 

Instances

Instances details
Eq MapType Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: MapType -> MapType -> Bool #

(/=) :: MapType -> MapType -> Bool #

Show MapType Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData MapType Source # 
Instance details

Defined in Web.Google.Maps.Static

data Language Source #

Language: supported languages based on the list at https://developers.google.com/maps/faq#languagesupport (as at 12 June 2021).

Constructors

Afrikaans

Since: 0.7.0.0

Albanian 
Amharic

Since: 0.7.0.0

Arabic 
Armenian

Since: 0.7.0.0

Azerbaijani

Since: 0.7.0.0

Basque 
Belarusian 
Bengali 
Bosnian

Since: 0.7.0.0

Bulgarian 
Burmese 
Catalan 
Chinese

Since: 0.7.0.0

ChineseSimplified 
ChineseHongKong

Since: 0.7.0.0

ChineseTraditional 
Croatian 
Czech 
Danish 
Dutch 
English 
EnglishAustralian 
EnglishBritish 
Estonian

Since: 0.7.0.0

Farsi 
Filipino 
Finnish 
French 
FrenchCanadian

Since: 0.7.0.0

Galician 
Georgian

Since: 0.7.0.0

German 
Greek 
Gujarati 
Hebrew 
Hindi 
Icelandic

Since: 0.7.0.0

Hungarian 
Indonesian 
Italian 
Japanese 
Kannada 
Kazakh 
Khmer

Since: 0.7.0.0

Korean 
Kyrgyz 
Lao

Since: 0.7.0.0

Latvian 
Lithuanian 
Macedonian 
Malay

Since: 0.7.0.0

Malayalam 
Marathi 
Mongolian

Since: 0.7.0.0

Nepali

Since: 0.7.0.0

Norwegian 
Polish 
Portuguese 
PortugueseBrazil 
PortuguesePortugal 
Punjabi 
Romanian 
Russian 
Serbian 
Sinhalese

Since: 0.7.0.0

Slovak 
Slovenian 
Spanish 
SpanishLatinAmerican

Since: 0.7.0.0

Swahili

Since: 0.7.0.0

Swedish 
Tagalog

No longer listed by Google at 12 June 2021. See Filipino.

Tamil 
Telugu 
Thai 
Turkish 
Ukrainian 
Urdu

Since: 0.7.0.0

Uzbek 
Vietnamese 
Zulu

Since: 0.7.0.0

Instances

Instances details
Eq Language Source # 
Instance details

Defined in Web.Google.Maps.Common

Show Language Source # 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Language Source # 
Instance details

Defined in Web.Google.Maps.Common

data Region Source #

Region: a ccTLD (country code top level domain).

Constructors

AD 
AE 
AF 
AG 
AI 
AL 
AM 
AO 
AQ 
AR 
AS 
AT 
AU 
AW 
AX 
AZ 
BA 
BB 
BD 
BE 
BF 
BG 
BH 
BI 
BJ 
BL 
BM 
BN 
BO 
BQ 
BR 
BS 
BT 
BV 
BW 
BY 
BZ 
CA 
CC 
CD 
CF 
CG 
CH 
CI 
CK 
CL 
CM 
CN 
CO 
CR 
CU 
CV 
CW 
CX 
CY 
CZ 
DE 
DJ 
DK 
DM 
DO 
DZ 
EC 
EE 
EG 
EH 
ER 
ES 
ET 
FI 
FJ 
FK 
FM 
FO 
FR 
GA 
GB 
GD 
GE 
GF 
GG 
GH 
GI 
GL 
GM 
GN 
GP 
GQ 
GR 
GS 
GT 
GU 
GW 
GY 
HK 
HM 
HN 
HR 
HT 
HU 
ID 
IE 
IL 
IM 
IN 
IO 
IQ 
IR 
IS 
IT 
JE 
JM 
JO 
JP 
KE 
KG 
KH 
KI 
KM 
KN 
KP 
KR 
KW 
KY 
KZ 
LA 
LB 
LC 
LI 
LK 
LR 
LS 
LT 
LU 
LV 
LY 
MA 
MC 
MD 
ME 
MF 
MG 
MH 
MK 
ML 
MM 
MN 
MO 
MP 
MQ 
MR 
MS 
MT 
MU 
MV 
MW 
MX 
MY 
MZ 
NA 
NC 
NE 
NF 
NG 
NI 
NL 
NO 
NP 
NR 
NU 
NZ 
OM 
PA 
PE 
PF 
PG 
PH 
PK 
PL 
PM 
PN 
PR 
PS 
PT 
PW 
PY 
QA 
RE 
RO 
RS 
RU 
RW 
SA 
SB 
SC 
SD 
SE 
SG 
SH 
SI 
SJ 
SK 
SL 
SM 
SN 
SO 
SR 
SS 
ST 
SV 
SX 
SY 
SZ 
TC 
TD 
TF 
TG 
TH 
TJ 
TK 
TL 
TM 
TN 
TO 
TR 
TT 
TV 
TW 
TZ 
UA 
UG 
UM 
US 
UY 
UZ 
VA 
VC 
VE 
VG 
VI 
VN 
VU 
WF 
WS 
YE 
YT 
ZA 
ZM 
ZW 
AC 
UK 
EU 

Instances

Instances details
Eq Region Source # 
Instance details

Defined in Web.Google.Maps.Common

Methods

(==) :: Region -> Region -> Bool #

(/=) :: Region -> Region -> Bool #

Show Region Source # 
Instance details

Defined in Web.Google.Maps.Common

ToHttpApiData Region Source # 
Instance details

Defined in Web.Google.Maps.Common

data Markers Source #

Markers

Constructors

Markers (Maybe MarkerStyle) [Location] 

Instances

Instances details
Eq Markers Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Markers -> Markers -> Bool #

(/=) :: Markers -> Markers -> Bool #

Show Markers Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData Markers Source # 
Instance details

Defined in Web.Google.Maps.Static

data MarkerSize Source #

Marker size

Constructors

Tiny 
Mid 
Small 

newtype MarkerLabel Source #

Marker label character

Constructors

MarkerLabel Char 

data StdColor Source #

Standard colours

Instances

Instances details
Eq StdColor Source # 
Instance details

Defined in Web.Google.Maps.Static

Show StdColor Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData StdColor Source # 
Instance details

Defined in Web.Google.Maps.Static

data URI #

Represents a general universal resource identifier using its component parts.

For example, for the URI

  foo://anonymous@www.haskell.org:42/ghc?query#frag

the components are:

Constructors

URI 

Fields

Instances

Instances details
Eq URI 
Instance details

Defined in Network.URI

Methods

(==) :: URI -> URI -> Bool #

(/=) :: URI -> URI -> Bool #

Data URI 
Instance details

Defined in Network.URI

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> URI -> c URI #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c URI #

toConstr :: URI -> Constr #

dataTypeOf :: URI -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c URI) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI) #

gmapT :: (forall b. Data b => b -> b) -> URI -> URI #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r #

gmapQ :: (forall d. Data d => d -> u) -> URI -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> URI -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> URI -> m URI #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> URI -> m URI #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> URI -> m URI #

Ord URI 
Instance details

Defined in Network.URI

Methods

compare :: URI -> URI -> Ordering #

(<) :: URI -> URI -> Bool #

(<=) :: URI -> URI -> Bool #

(>) :: URI -> URI -> Bool #

(>=) :: URI -> URI -> Bool #

max :: URI -> URI -> URI #

min :: URI -> URI -> URI #

Show URI 
Instance details

Defined in Network.URI

Methods

showsPrec :: Int -> URI -> ShowS #

show :: URI -> String #

showList :: [URI] -> ShowS #

Generic URI 
Instance details

Defined in Network.URI

Associated Types

type Rep URI :: Type -> Type #

Methods

from :: URI -> Rep URI x #

to :: Rep URI x -> URI #

NFData URI 
Instance details

Defined in Network.URI

Methods

rnf :: URI -> () #

Lift URI 
Instance details

Defined in Network.URI

Methods

lift :: URI -> Q Exp #

liftTyped :: URI -> Q (TExp URI) #

type Rep URI 
Instance details

Defined in Network.URI

data URIAuth #

Type for authority value within a URI

Constructors

URIAuth 

Fields

Instances

Instances details
Eq URIAuth 
Instance details

Defined in Network.URI

Methods

(==) :: URIAuth -> URIAuth -> Bool #

(/=) :: URIAuth -> URIAuth -> Bool #

Data URIAuth 
Instance details

Defined in Network.URI

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> URIAuth -> c URIAuth #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c URIAuth #

toConstr :: URIAuth -> Constr #

dataTypeOf :: URIAuth -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c URIAuth) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URIAuth) #

gmapT :: (forall b. Data b => b -> b) -> URIAuth -> URIAuth #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URIAuth -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URIAuth -> r #

gmapQ :: (forall d. Data d => d -> u) -> URIAuth -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> URIAuth -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> URIAuth -> m URIAuth #

Ord URIAuth 
Instance details

Defined in Network.URI

Show URIAuth 
Instance details

Defined in Network.URI

Generic URIAuth 
Instance details

Defined in Network.URI

Associated Types

type Rep URIAuth :: Type -> Type #

Methods

from :: URIAuth -> Rep URIAuth x #

to :: Rep URIAuth x -> URIAuth #

NFData URIAuth 
Instance details

Defined in Network.URI

Methods

rnf :: URIAuth -> () #

Lift URIAuth 
Instance details

Defined in Network.URI

Methods

lift :: URIAuth -> Q Exp #

liftTyped :: URIAuth -> Q (TExp URIAuth) #

type Rep URIAuth 
Instance details

Defined in Network.URI

type Rep URIAuth = D1 ('MetaData "URIAuth" "Network.URI" "network-uri-2.6.4.1-3rjR9AKf8Rm5zFnzIORPH4" 'False) (C1 ('MetaCons "URIAuth" 'PrefixI 'True) (S1 ('MetaSel ('Just "uriUserInfo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: (S1 ('MetaSel ('Just "uriRegName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: S1 ('MetaSel ('Just "uriPort") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))))

data Anchor Source #

Anchor

Instances

Instances details
Eq Anchor Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Anchor -> Anchor -> Bool #

(/=) :: Anchor -> Anchor -> Bool #

Show Anchor Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData Anchor Source # 
Instance details

Defined in Web.Google.Maps.Static

data Path Source #

Path

Constructors

Path (Maybe PathStyle) [Location] 

Instances

Instances details
Eq Path Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Path -> Path -> Bool #

(/=) :: Path -> Path -> Bool #

Show Path Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

showsPrec :: Int -> Path -> ShowS #

show :: Path -> String #

showList :: [Path] -> ShowS #

ToHttpApiData Path Source # 
Instance details

Defined in Web.Google.Maps.Static

data PathStyle Source #

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

Constructors

PathStyle 

Fields

newtype PathWeight Source #

Path weight: in pixels.

Constructors

PathWeight Int 

newtype Visible Source #

Visible locations

Constructors

Visible [Location] 

Instances

Instances details
Eq Visible Source # 
Instance details

Defined in Web.Google.Maps.Static

Methods

(==) :: Visible -> Visible -> Bool #

(/=) :: Visible -> Visible -> Bool #

Show Visible Source # 
Instance details

Defined in Web.Google.Maps.Static

ToHttpApiData Visible Source # 
Instance details

Defined in Web.Google.Maps.Static

type StaticmapResponse = DynamicImage Source #

StaticmapResponse