google-static-maps-0.5.0.0: Bindings to the Google Static Maps API

Copyright(c) Mike Pilgrem 2017
Maintainerpublic@pilgrem.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

Web.Google.Static.Maps

Contents

Description

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

The Google Static Maps 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 Static Maps API services is subject to the Google Maps APIs Terms of Service, which terms restrict the use of content.

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 Static Maps 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.Static.Maps (Center (..), Key (..), Location (..), Size (..),
    staticmap, StaticmapResponse (..), Zoom (..))

main :: IO ()
main = do
    putStrLn "A test of the Google Static Maps API.\nNB: The use of the \
        \API services is subject to the Google Maps APIs Terms of Serivce \
        \at https://developers.google.com/maps/terms.\n"
    mgr <- newManager tlsManagerSettings
    let apiKey = Key "<REPLACE_THIS_WITH_YOUR_ACTUAL_GOOGLE_API_KEY>"
        secret = Just $ Secret "<REPLACE_THIS_WITH_YOUR_ACTUAL_GOOGLE_\
            \URL_SIGNING_SECRET>"  -- If using a digital signature
        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 Static Maps 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 ServantError StaticmapResponse) Source #

Retrieve a static map. NB: The use of the Google Static Maps API services is subject to the Google Maps APIs Terms of Service.

API

type GoogleStaticMapsAPI = "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 Static Maps API

Types

newtype Key Source #

API key

Constructors

Key Text 

newtype Secret Source #

Secret for digital signature

Constructors

Secret Text 

Instances

newtype Center Source #

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

Constructors

Center Location 

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

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 

data Size Source #

Size in pixels: there are maximum allowable values.

Constructors

Size 

Fields

data Scale Source #

Scale

Constructors

Single

The default value.

Double 
Quadruple 

data Format Source #

Image format

Constructors

Png8

The default value.

Png32 

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 

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

Eq URI 

Methods

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

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

Data 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 :: (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 

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 

Methods

showsPrec :: Int -> URI -> ShowS #

show :: URI -> String #

showList :: [URI] -> ShowS #

Generic URI 

Associated Types

type Rep URI :: * -> * #

Methods

from :: URI -> Rep URI x #

to :: Rep URI x -> URI #

NFData URI 

Methods

rnf :: URI -> () #

type Rep URI 

data URIAuth :: * #

Type for authority value within a URI

Constructors

URIAuth 

Fields

Instances

Eq URIAuth 

Methods

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

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

Data URIAuth 

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 :: (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 
Show URIAuth 
NFData URIAuth 

Methods

rnf :: URIAuth -> () #

data PathStyle Source #

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

Constructors

PathStyle 

Fields

type StaticmapResponse = DynamicImage Source #

StaticmapResponse