google-static-maps 0.7.0.2 → 0.7.0.3
raw patch · 5 files changed
+1238/−1221 lines, 5 filesdep ~aesondep ~basedep ~bytestringPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: aeson, base, bytestring, servant, servant-client, text
API changes (from Hackage documentation)
- Web.Google.Maps.Static: data URI
+ Web.Google.Maps.Static: data () => URI
- Web.Google.Maps.Static: data URIAuth
+ Web.Google.Maps.Static: data () => URIAuth
Files
- changelog.md +4/−0
- google-static-maps.cabal +8/−8
- src/Web/Google/Maps/Common.hs +746/−746
- src/Web/Google/Maps/Static.hs +479/−461
- stack.yaml +1/−6
changelog.md view
@@ -1,3 +1,7 @@+# 0.7.0.3 + +* Update dependencies for GHC 9.4.1 to GHC 9.8.3 and revisit upper bounds + # 0.7.0.2 * Update dependencies for GHC 9.2.8 and revisit upper bounds
google-static-maps.cabal view
@@ -1,9 +1,9 @@ name: google-static-maps -version: 0.7.0.2 +version: 0.7.0.3 synopsis: Bindings to the Google Maps Static API (formerly Static Maps API) description: The - <https://developers.google.com/maps/documentation/maps-static/intro Google Maps Static API> + <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. . @@ -35,21 +35,21 @@ hs-source-dirs: src exposed-modules: Web.Google.Maps.Static , Web.Google.Maps.Common - build-depends: base >= 4.8 && < 4.17 - , aeson >= 0.7 && < 2.2 + build-depends: base >= 4.8 && < 4.20 + , aeson >= 0.7 && < 2.3 , base64-bytestring >= 0.1.1 && < 1.3 , bytedump >= 0.9 && < 1.1 - , bytestring >= 0.10 && < 0.12 + , bytestring >= 0.10 && < 0.13 , cryptonite >= 0.1 && < 0.31 , double-conversion >= 0.2 && < 2.1 , http-client >= 0.2 && < 0.8 , JuicyPixels >= 1.0 && < 3.4 , memory >= 0.1 && < 0.19 , network-uri >= 2.6 && < 2.8 - , servant >= 0.16 && < 0.20 - , servant-client >= 0.16 && < 0.20 + , servant >= 0.16 && < 0.21 + , servant-client >= 0.16 && < 0.21 , servant-JuicyPixels >= 0.3 && < 0.4 - , text >= 1.0 && < 2.1 + , text >= 1.0 && < 2.2 , utf8-string >= 0.3 && < 1.1 default-language: Haskell2010 ghc-options: -Wall
src/Web/Google/Maps/Common.hs view
@@ -13,752 +13,752 @@ -- -- This module has no connection with Google Inc. or its affiliates. module Web.Google.Maps.Common - ( -- * Functions - googleMapsApis - -- * Types - , Address (..) - , Key (..) - , Language (..) - , LatLng (..) - , Location (..) - , Region (..) - ) where - -import Data.Aeson (FromJSON) -import Data.Double.Conversion.Text (toFixed) -import Data.Eq (Eq) -import Data.Function (($)) -import Data.List (intersperse, map) -import Data.Text (Text) -import qualified Data.Text as T (concat) -import GHC.Exts (Double) -import GHC.Generics (Generic) -import Servant.API (ToHttpApiData (..)) -import Servant.Client (BaseUrl (..), Scheme (..)) -import Text.Show (Show) - --- | API key -newtype Key = Key Text - deriving (Eq, Show, ToHttpApiData) - --- | Location -data Location - = Coords LatLng - | Locale Address - deriving (Eq, Show) - -instance ToHttpApiData Location where - toUrlPiece location - | Coords latlng <- location - = toUrlPiece latlng - | Locale address <- location - = toUrlPiece address - -instance ToHttpApiData [Location] where - toUrlPiece [] = "" - toUrlPiece ls = T.concat $ intersperse "|" $ map toUrlPiece ls - --- | Latitude and longitude: precision beyond 6 decimal places is ignored. -data LatLng = LatLng - { lat :: Double -- ^ Takes any value between -90 and 90. - , lng :: Double -- ^ Takes any value between -180 and 180. - } deriving (Eq, Show, Generic) - -instance ToHttpApiData LatLng where - toUrlPiece (LatLng lat' lng') - = T.concat [toFixed precision lat', ",", toFixed precision lng'] - where - precision = 6 -- Precision beyond 6 decimal places is ignored. - -instance FromJSON LatLng - --- | Address -newtype Address = Address Text - deriving (Eq, Show, ToHttpApiData) - --- | Language: supported languages based on the list at --- <https://developers.google.com/maps/faq#languagesupport> (as at 20 March --- 2022). -data Language - = 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 - deriving (Eq, Show) - -instance ToHttpApiData Language where - toUrlPiece language = case language of - Afrikaans -> "af" - Albanian -> "sq" - Amharic -> "am" - Arabic -> "ar" - Armenian -> "hy" - Azerbaijani -> "az" - Basque -> "eu" - Belarusian -> "be" - Bengali -> "bn" - Bosnian -> "bs" - Bulgarian -> "bg" - Burmese -> "my" - Catalan -> "ca" - Chinese -> "zh" - ChineseSimplified -> "zh-CN" - ChineseHongKong -> "zh-HK" - ChineseTraditional -> "zh-TW" - Croatian -> "hr" - Czech -> "cs" - Danish -> "da" - Dutch -> "nl" - English -> "en" - EnglishAustralian -> "en-AU" - EnglishBritish -> "en-GB" - Estonian -> "et" - Farsi -> "fa" - Filipino -> "fil" - Finnish -> "fi" - French -> "fr" - FrenchCanadian -> "fr-CA" - Galician -> "gl" - Georgian -> "ka" - German -> "de" - Greek -> "el" - Gujarati -> "gu" - Hebrew -> "iw" - Hindi -> "hi" - Hungarian -> "hu" - Icelandic -> "is" - Indonesian -> "id" - Italian -> "it" - Japanese -> "ja" - Kannada -> "kn" - Kazakh -> "kk" - Khmer -> "km" - Korean -> "ko" - Kyrgyz -> "ky" - Lao -> "lo" - Latvian -> "lv" - Lithuanian -> "lt" - Macedonian -> "mk" - Malay -> "ms" - Malayalam -> "ml" - Marathi -> "mr" - Mongolian -> "mn" - Nepali -> "ne" - Norwegian -> "no" - Polish -> "pl" - Portuguese -> "pt" - PortugueseBrazil -> "pt-BR" - PortuguesePortugal -> "pt-PT" - Punjabi -> "pa" - Romanian -> "ro" - Russian -> "ru" - Serbian -> "sr" - Sinhalese -> "si" - Slovak -> "sk" - Slovenian -> "sl" - Spanish -> "es" - SpanishLatinAmerican -> "es-419" - Swahili -> "sw" - Swedish -> "sv" - Tagalog -> "tl" - Tamil -> "ta" - Telugu -> "te" - Thai -> "th" - Turkish -> "tr" - Ukrainian -> "uk" - Urdu -> "ur" - Uzbek -> "uz" - Vietnamese -> "vi" - Zulu -> "zu" - --- | Region: a ccTLD (country code top level domain). -data Region - = 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 -- Saint Helena, Ascension and Tristan da Cunha - | UK -- United Kingdom of Great Britain and Northern Ireland - | EU -- European Union - deriving (Eq, Show) - -instance ToHttpApiData Region where - toUrlPiece region = case region of - AD -> "ad" - AE -> "ae" - AF -> "af" - AG -> "ag" - AI -> "ai" - AL -> "al" - AM -> "am" - AO -> "ao" - AQ -> "aq" - AR -> "ar" - AS -> "as" - AT -> "at" - AU -> "au" - AW -> "aw" - AX -> "ax" - AZ -> "az" - BA -> "ba" - BB -> "bb" - BD -> "bd" - BE -> "be" - BF -> "bf" - BG -> "bg" - BH -> "bh" - BI -> "bi" - BJ -> "bj" - BL -> "bl" - BM -> "bm" - BN -> "bn" - BO -> "bo" - BQ -> "bq" - BR -> "br" - BS -> "bs" - BT -> "bt" - BV -> "bv" - BW -> "bw" - BY -> "by" - BZ -> "bz" - CA -> "ca" - CC -> "cc" - CD -> "cd" - CF -> "cf" - CG -> "cg" - CH -> "ch" - CI -> "ci" - CK -> "ck" - CL -> "cl" - CM -> "cm" - CN -> "cn" - CO -> "co" - CR -> "cr" - CU -> "cu" - CV -> "cv" - CW -> "cw" - CX -> "cx" - CY -> "cy" - CZ -> "cz" - DE -> "de" - DJ -> "dj" - DK -> "dk" - DM -> "dm" - DO -> "do" - DZ -> "dz" - EC -> "ec" - EE -> "ee" - EG -> "eg" - EH -> "eh" - ER -> "er" - ES -> "es" - ET -> "et" - FI -> "fi" - FJ -> "fj" - FK -> "fk" - FM -> "fm" - FO -> "fo" - FR -> "fr" - GA -> "ga" - GB -> "gb" - GD -> "gd" - GE -> "ge" - GF -> "gf" - GG -> "gg" - GH -> "gh" - GI -> "gi" - GL -> "gl" - GM -> "gm" - GN -> "gn" - GP -> "gp" - GQ -> "gq" - GR -> "gr" - GS -> "gs" - GT -> "gt" - GU -> "gu" - GW -> "gw" - GY -> "gy" - HK -> "hk" - HM -> "hm" - HN -> "hn" - HR -> "hr" - HT -> "ht" - HU -> "hu" - ID -> "id" - IE -> "ie" - IL -> "il" - IM -> "im" - IN -> "in" - IO -> "io" - IQ -> "iq" - IR -> "ir" - IS -> "is" - IT -> "it" - JE -> "je" - JM -> "jm" - JO -> "jo" - JP -> "jp" - KE -> "ke" - KG -> "kg" - KH -> "kh" - KI -> "ki" - KM -> "km" - KN -> "kn" - KP -> "kp" - KR -> "kr" - KW -> "kw" - KY -> "ky" - KZ -> "kz" - LA -> "la" - LB -> "lb" - LC -> "lc" - LI -> "li" - LK -> "lk" - LR -> "lr" - LS -> "ls" - LT -> "lt" - LU -> "lu" - LV -> "lv" - LY -> "ly" - MA -> "ma" - MC -> "mc" - MD -> "md" - ME -> "me" - MF -> "mf" - MG -> "mg" - MH -> "mh" - MK -> "mk" - ML -> "ml" - MM -> "mm" - MN -> "mn" - MO -> "mo" - MP -> "mp" - MQ -> "mq" - MR -> "mr" - MS -> "ms" - MT -> "mt" - MU -> "mu" - MV -> "mv" - MW -> "mw" - MX -> "mx" - MY -> "my" - MZ -> "mz" - NA -> "na" - NC -> "nc" - NE -> "ne" - NF -> "nf" - NG -> "ng" - NI -> "ni" - NL -> "nl" - NO -> "no" - NP -> "np" - NR -> "nr" - NU -> "nu" - NZ -> "nz" - OM -> "om" - PA -> "pa" - PE -> "pe" - PF -> "pf" - PG -> "pg" - PH -> "ph" - PK -> "pk" - PL -> "pl" - PM -> "pm" - PN -> "pn" - PR -> "pr" - PS -> "ps" - PT -> "pt" - PW -> "pw" - PY -> "py" - QA -> "qa" - RE -> "re" - RO -> "ro" - RS -> "rs" - RU -> "ru" - RW -> "rw" - SA -> "sa" - SB -> "sb" - SC -> "sc" - SD -> "sd" - SE -> "se" - SG -> "sg" - SH -> "sh" - SI -> "si" - SJ -> "sj" - SK -> "sk" - SL -> "sl" - SM -> "sm" - SN -> "sn" - SO -> "so" - SR -> "sr" - SS -> "ss" - ST -> "st" - SV -> "sv" - SX -> "sx" - SY -> "sy" - SZ -> "sz" - TC -> "tc" - TD -> "td" - TF -> "tf" - TG -> "tg" - TH -> "th" - TJ -> "tj" - TK -> "tk" - TL -> "tl" - TM -> "tm" - TN -> "tn" - TO -> "to" - TR -> "tr" - TT -> "tt" - TV -> "tv" - TW -> "tw" - TZ -> "tz" - UA -> "ua" - UG -> "ug" - UM -> "um" - US -> "us" - UY -> "uy" - UZ -> "uz" - VA -> "va" - VC -> "vc" - VE -> "ve" - VG -> "vg" - VI -> "vi" - VN -> "vn" - VU -> "vu" - WF -> "wf" - WS -> "ws" - YE -> "ye" - YT -> "yt" - ZA -> "za" - ZM -> "zm" - ZW -> "zw" - AC -> "ac" -- Saint Helena, Ascension and Tristan da Cunha - UK -> "uk" -- United Kingdom of Great Britain and Northern Ireland - EU -> "eu" -- European Union + ( -- * Functions + googleMapsApis + -- * Types + , Address (..) + , Key (..) + , Language (..) + , LatLng (..) + , Location (..) + , Region (..) + ) where + +import Data.Aeson ( FromJSON ) +import Data.Double.Conversion.Text ( toFixed ) +import Data.Eq ( Eq ) +import Data.Function ( ($) ) +import Data.List ( intersperse, map ) +import Data.Text ( Text ) +import qualified Data.Text as T ( concat ) +import GHC.Exts ( Double ) +import GHC.Generics ( Generic ) +import Servant.API ( ToHttpApiData (..) ) +import Servant.Client ( BaseUrl (..), Scheme (..) ) +import Text.Show ( Show ) + +-- | API key +newtype Key = Key Text + deriving (Eq, Show, ToHttpApiData) + +-- | Location +data Location + = Coords LatLng + | Locale Address + deriving (Eq, Show) + +instance ToHttpApiData Location where + toUrlPiece location + | Coords latlng <- location + = toUrlPiece latlng + | Locale address <- location + = toUrlPiece address + +instance ToHttpApiData [Location] where + toUrlPiece [] = "" + toUrlPiece ls = T.concat $ intersperse "|" $ map toUrlPiece ls + +-- | Latitude and longitude: precision beyond 6 decimal places is ignored. +data LatLng = LatLng + { lat :: Double -- ^ Takes any value between -90 and 90. + , lng :: Double -- ^ Takes any value between -180 and 180. + } deriving (Eq, Show, Generic) + +instance ToHttpApiData LatLng where + toUrlPiece (LatLng lat' lng') + = T.concat [toFixed precision lat', ",", toFixed precision lng'] + where + precision = 6 -- Precision beyond 6 decimal places is ignored. + +instance FromJSON LatLng + +-- | Address +newtype Address = Address Text + deriving (Eq, Show, ToHttpApiData) + +-- | Language: supported languages based on the list at +-- <https://developers.google.com/maps/faq#languagesupport> (as at 27 October +-- 2024). +data Language + = 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 + | Hungarian + | Icelandic -- ^ @since 0.7.0.0 + | 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 + deriving (Eq, Show) + +instance ToHttpApiData Language where + toUrlPiece language = case language of + Afrikaans -> "af" + Albanian -> "sq" + Amharic -> "am" + Arabic -> "ar" + Armenian -> "hy" + Azerbaijani -> "az" + Basque -> "eu" + Belarusian -> "be" + Bengali -> "bn" + Bosnian -> "bs" + Bulgarian -> "bg" + Burmese -> "my" + Catalan -> "ca" + Chinese -> "zh" + ChineseSimplified -> "zh-CN" + ChineseHongKong -> "zh-HK" + ChineseTraditional -> "zh-TW" + Croatian -> "hr" + Czech -> "cs" + Danish -> "da" + Dutch -> "nl" + English -> "en" + EnglishAustralian -> "en-AU" + EnglishBritish -> "en-GB" + Estonian -> "et" + Farsi -> "fa" + Filipino -> "fil" + Finnish -> "fi" + French -> "fr" + FrenchCanadian -> "fr-CA" + Galician -> "gl" + Georgian -> "ka" + German -> "de" + Greek -> "el" + Gujarati -> "gu" + Hebrew -> "iw" + Hindi -> "hi" + Hungarian -> "hu" + Icelandic -> "is" + Indonesian -> "id" + Italian -> "it" + Japanese -> "ja" + Kannada -> "kn" + Kazakh -> "kk" + Khmer -> "km" + Korean -> "ko" + Kyrgyz -> "ky" + Lao -> "lo" + Latvian -> "lv" + Lithuanian -> "lt" + Macedonian -> "mk" + Malay -> "ms" + Malayalam -> "ml" + Marathi -> "mr" + Mongolian -> "mn" + Nepali -> "ne" + Norwegian -> "no" + Polish -> "pl" + Portuguese -> "pt" + PortugueseBrazil -> "pt-BR" + PortuguesePortugal -> "pt-PT" + Punjabi -> "pa" + Romanian -> "ro" + Russian -> "ru" + Serbian -> "sr" + Sinhalese -> "si" + Slovak -> "sk" + Slovenian -> "sl" + Spanish -> "es" + SpanishLatinAmerican -> "es-419" + Swahili -> "sw" + Swedish -> "sv" + Tagalog -> "tl" + Tamil -> "ta" + Telugu -> "te" + Thai -> "th" + Turkish -> "tr" + Ukrainian -> "uk" + Urdu -> "ur" + Uzbek -> "uz" + Vietnamese -> "vi" + Zulu -> "zu" + +-- | Region: a ccTLD (country code top level domain). +data Region + = 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 -- Saint Helena, Ascension and Tristan da Cunha + | UK -- United Kingdom of Great Britain and Northern Ireland + | EU -- European Union + deriving (Eq, Show) + +instance ToHttpApiData Region where + toUrlPiece region = case region of + AD -> "ad" + AE -> "ae" + AF -> "af" + AG -> "ag" + AI -> "ai" + AL -> "al" + AM -> "am" + AO -> "ao" + AQ -> "aq" + AR -> "ar" + AS -> "as" + AT -> "at" + AU -> "au" + AW -> "aw" + AX -> "ax" + AZ -> "az" + BA -> "ba" + BB -> "bb" + BD -> "bd" + BE -> "be" + BF -> "bf" + BG -> "bg" + BH -> "bh" + BI -> "bi" + BJ -> "bj" + BL -> "bl" + BM -> "bm" + BN -> "bn" + BO -> "bo" + BQ -> "bq" + BR -> "br" + BS -> "bs" + BT -> "bt" + BV -> "bv" + BW -> "bw" + BY -> "by" + BZ -> "bz" + CA -> "ca" + CC -> "cc" + CD -> "cd" + CF -> "cf" + CG -> "cg" + CH -> "ch" + CI -> "ci" + CK -> "ck" + CL -> "cl" + CM -> "cm" + CN -> "cn" + CO -> "co" + CR -> "cr" + CU -> "cu" + CV -> "cv" + CW -> "cw" + CX -> "cx" + CY -> "cy" + CZ -> "cz" + DE -> "de" + DJ -> "dj" + DK -> "dk" + DM -> "dm" + DO -> "do" + DZ -> "dz" + EC -> "ec" + EE -> "ee" + EG -> "eg" + EH -> "eh" + ER -> "er" + ES -> "es" + ET -> "et" + FI -> "fi" + FJ -> "fj" + FK -> "fk" + FM -> "fm" + FO -> "fo" + FR -> "fr" + GA -> "ga" + GB -> "gb" + GD -> "gd" + GE -> "ge" + GF -> "gf" + GG -> "gg" + GH -> "gh" + GI -> "gi" + GL -> "gl" + GM -> "gm" + GN -> "gn" + GP -> "gp" + GQ -> "gq" + GR -> "gr" + GS -> "gs" + GT -> "gt" + GU -> "gu" + GW -> "gw" + GY -> "gy" + HK -> "hk" + HM -> "hm" + HN -> "hn" + HR -> "hr" + HT -> "ht" + HU -> "hu" + ID -> "id" + IE -> "ie" + IL -> "il" + IM -> "im" + IN -> "in" + IO -> "io" + IQ -> "iq" + IR -> "ir" + IS -> "is" + IT -> "it" + JE -> "je" + JM -> "jm" + JO -> "jo" + JP -> "jp" + KE -> "ke" + KG -> "kg" + KH -> "kh" + KI -> "ki" + KM -> "km" + KN -> "kn" + KP -> "kp" + KR -> "kr" + KW -> "kw" + KY -> "ky" + KZ -> "kz" + LA -> "la" + LB -> "lb" + LC -> "lc" + LI -> "li" + LK -> "lk" + LR -> "lr" + LS -> "ls" + LT -> "lt" + LU -> "lu" + LV -> "lv" + LY -> "ly" + MA -> "ma" + MC -> "mc" + MD -> "md" + ME -> "me" + MF -> "mf" + MG -> "mg" + MH -> "mh" + MK -> "mk" + ML -> "ml" + MM -> "mm" + MN -> "mn" + MO -> "mo" + MP -> "mp" + MQ -> "mq" + MR -> "mr" + MS -> "ms" + MT -> "mt" + MU -> "mu" + MV -> "mv" + MW -> "mw" + MX -> "mx" + MY -> "my" + MZ -> "mz" + NA -> "na" + NC -> "nc" + NE -> "ne" + NF -> "nf" + NG -> "ng" + NI -> "ni" + NL -> "nl" + NO -> "no" + NP -> "np" + NR -> "nr" + NU -> "nu" + NZ -> "nz" + OM -> "om" + PA -> "pa" + PE -> "pe" + PF -> "pf" + PG -> "pg" + PH -> "ph" + PK -> "pk" + PL -> "pl" + PM -> "pm" + PN -> "pn" + PR -> "pr" + PS -> "ps" + PT -> "pt" + PW -> "pw" + PY -> "py" + QA -> "qa" + RE -> "re" + RO -> "ro" + RS -> "rs" + RU -> "ru" + RW -> "rw" + SA -> "sa" + SB -> "sb" + SC -> "sc" + SD -> "sd" + SE -> "se" + SG -> "sg" + SH -> "sh" + SI -> "si" + SJ -> "sj" + SK -> "sk" + SL -> "sl" + SM -> "sm" + SN -> "sn" + SO -> "so" + SR -> "sr" + SS -> "ss" + ST -> "st" + SV -> "sv" + SX -> "sx" + SY -> "sy" + SZ -> "sz" + TC -> "tc" + TD -> "td" + TF -> "tf" + TG -> "tg" + TH -> "th" + TJ -> "tj" + TK -> "tk" + TL -> "tl" + TM -> "tm" + TN -> "tn" + TO -> "to" + TR -> "tr" + TT -> "tt" + TV -> "tv" + TW -> "tw" + TZ -> "tz" + UA -> "ua" + UG -> "ug" + UM -> "um" + US -> "us" + UY -> "uy" + UZ -> "uz" + VA -> "va" + VC -> "vc" + VE -> "ve" + VG -> "vg" + VI -> "vi" + VN -> "vn" + VU -> "vu" + WF -> "wf" + WS -> "ws" + YE -> "ye" + YT -> "yt" + ZA -> "za" + ZM -> "zm" + ZW -> "zw" + AC -> "ac" -- Saint Helena, Ascension and Tristan da Cunha + UK -> "uk" -- United Kingdom of Great Britain and Northern Ireland + EU -> "eu" -- European Union -- | The base URL for the Google Maps Platform APIs. googleMapsApis :: BaseUrl
src/Web/Google/Maps/Static.hs view
@@ -9,13 +9,13 @@ -- Module : Web.Google.Maps.Static -- Description : Bindings to the Google Maps Static API (formerly Static Maps -- API) --- Copyright : (c) Mike Pilgrem 2017, 2018 +-- 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/intro Google Maps Static API> +-- 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). -- @@ -69,516 +69,520 @@ -- > 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 + ( -- * 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) +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) +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 (..)) +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 (Eq, Show) + deriving (Eq, Show) -- | Signature newtype Signature = Signature Text - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, ToHttpApiData) -- | Center of the map: not required if the map includes markers or paths. newtype Center = Center Location - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, 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 (Eq, Show, ToHttpApiData) + deriving (Eq, Show, ToHttpApiData) -- | Size in pixels: there are maximum allowable values. data Size = Size - { width :: Int - , height :: Int - } deriving (Eq, Show) + { width :: Int + , height :: Int + } deriving (Eq, Show) instance ToHttpApiData Size where - toUrlPiece (Size width' height') = - T.pack (show width' ++ "x" ++ show height') + toUrlPiece (Size width' height') = + T.pack (show width' ++ "x" ++ show height') -- | Scale data Scale - = Single -- ^ The default value. - | Double - | Quadruple - deriving (Eq, Show) + = Single -- ^ The default value. + | Double + | Quadruple + deriving (Eq, Show) instance ToHttpApiData Scale where - toUrlPiece scale = case scale of - Single -> "1" - Double -> "2" - Quadruple -> "4" + toUrlPiece scale = case scale of + Single -> "1" + Double -> "2" + Quadruple -> "4" -- | Image format data Format - = Png8 -- ^ The default value. - | Png32 - deriving (Eq, Show) + = Png8 -- ^ The default value. + | Png32 + deriving (Eq, Show) instance ToHttpApiData Format where - toUrlPiece format = case format of - Png8 -> "png8" - Png32 -> "png32" + toUrlPiece format = case format of + Png8 -> "png8" + Png32 -> "png32" -- | MapStyle data MapStyle = MapStyle (Maybe Feature) (Maybe Element) [MapStyleOp] - deriving (Eq, Show) + deriving (Eq, Show) instance ToHttpApiData MapStyle where - toUrlPiece (MapStyle featureOpt elementOpt ops) = - T.concat $ intersperse "|" $ catMaybes [featureUrl, elementUrl] ++ - [opsUrl] - where - featureUrl = T.append "feature:" . toUrlPiece <$> featureOpt - elementUrl = T.append "element:" . toUrlPiece <$> elementOpt - opsUrl = toUrlPiece ops + toUrlPiece (MapStyle featureOpt elementOpt ops) = + T.concat $ intersperse "|" $ catMaybes [featureUrl, elementUrl] ++ [opsUrl] + where + featureUrl = T.append "feature:" . toUrlPiece <$> featureOpt + elementUrl = T.append "element:" . toUrlPiece <$> elementOpt + opsUrl = toUrlPiece 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 (Eq, Show) + = 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 (Eq, Show) instance ToHttpApiData Feature where - toUrlPiece feature = case feature of - AllFeatures -> "all" - Administrative -> "administrative" - AdministrativeCountry -> "administrative.country" - AdministrativeLandParcel -> "administrative.land_parcel" - AdministrativeLocality -> "administrative.locality" - AdministrativeNeighborhood -> "administrative.neighborhood" - AdministrativeProvince -> "administrative.province" - Landscape -> "landscape" - LandscapeManMade -> "landscape.man_made" - LandscapeNatural -> "landscape.natural" - LandscapeNaturalLandcover -> "landscape.landcover" - LandscapeNaturalTerrain -> "landscape.terrain" - Poi -> "poi" - PoiAttraction -> "poi.attraction" - PoiBusiness -> "poi.business" - PoiGovernment -> "poi.government" - PoiMedical -> "poi.medical" - PoiPark -> "poi.park" - PoiPlaceOfWorship -> "poi.place_of_worship" - PoiSchool -> "poi.school" - PoiSportsComplex -> "poi.sports_complex" - Road -> "road" - RoadArterial -> "road.arterial" - RoadHighway -> "road.highway" - RoadHighwayControlledAccess -> "road.controlled_access" - RoadLocal -> "road.local" - Transit -> "transit" - TransitLine -> "transit.line" - TransitStation -> "transit.station" - TransitStationAirport -> "transit.station.airport" - TransitStationBus -> "transit.station.bus" - TransitStationRail -> "transit.station.rail" - Water -> "water" + toUrlPiece feature = case feature of + AllFeatures -> "all" + Administrative -> "administrative" + AdministrativeCountry -> "administrative.country" + AdministrativeLandParcel -> "administrative.land_parcel" + AdministrativeLocality -> "administrative.locality" + AdministrativeNeighborhood -> "administrative.neighborhood" + AdministrativeProvince -> "administrative.province" + Landscape -> "landscape" + LandscapeManMade -> "landscape.man_made" + LandscapeNatural -> "landscape.natural" + LandscapeNaturalLandcover -> "landscape.landcover" + LandscapeNaturalTerrain -> "landscape.terrain" + Poi -> "poi" + PoiAttraction -> "poi.attraction" + PoiBusiness -> "poi.business" + PoiGovernment -> "poi.government" + PoiMedical -> "poi.medical" + PoiPark -> "poi.park" + PoiPlaceOfWorship -> "poi.place_of_worship" + PoiSchool -> "poi.school" + PoiSportsComplex -> "poi.sports_complex" + Road -> "road" + RoadArterial -> "road.arterial" + RoadHighway -> "road.highway" + RoadHighwayControlledAccess -> "road.controlled_access" + RoadLocal -> "road.local" + Transit -> "transit" + TransitLine -> "transit.line" + TransitStation -> "transit.station" + TransitStationAirport -> "transit.station.airport" + TransitStationBus -> "transit.station.bus" + TransitStationRail -> "transit.station.rail" + Water -> "water" -- | Feature element data Element - = AllElements - | AllGeometry - | GeometryFill - | GeometryStroke - | AllLabels - | LabelsIcon - | LabelsText - | LabelsTextFill - | LabelsTextStroke - deriving (Eq, Show) + = AllElements + | AllGeometry + | GeometryFill + | GeometryStroke + | AllLabels + | LabelsIcon + | LabelsText + | LabelsTextFill + | LabelsTextStroke + deriving (Eq, Show) instance ToHttpApiData Element where - toUrlPiece element = case element of - AllElements -> "all" - AllGeometry -> "geometry" - GeometryFill -> "geometry.fill" - GeometryStroke -> "geometry.stroke" - AllLabels -> "labels" - LabelsIcon -> "labels.icon" - LabelsText -> "labels.text" - LabelsTextFill -> "labels.text.fill" - LabelsTextStroke -> "labels.text.stroke" + toUrlPiece element = case element of + AllElements -> "all" + AllGeometry -> "geometry" + GeometryFill -> "geometry.fill" + GeometryStroke -> "geometry.stroke" + AllLabels -> "labels" + LabelsIcon -> "labels.icon" + LabelsText -> "labels.text" + LabelsTextFill -> "labels.text.fill" + LabelsTextStroke -> "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 (Eq, Show) + = StyleHue Word8 Word8 Word8 + | StyleLightness Double + | StyleSaturation Double + | StyleGamma Double + | StyleInvertLightness Bool + | StyleVisibility Visibility + | StyleColor Word8 Word8 Word8 + | StyleWeight Int + deriving (Eq, Show) instance ToHttpApiData MapStyleOp where - toUrlPiece mapStyleOp - | StyleHue r g b <- mapStyleOp - = T.pack $ "hue:0x" ++ hexString r ++ hexString g ++ hexString b - | StyleLightness l <- mapStyleOp - = T.concat ["lightness:", toUrlPiece l] - | StyleSaturation s <- mapStyleOp - = T.concat ["saturation:", toUrlPiece s] - | StyleGamma g <- mapStyleOp - = T.concat ["gamma:", toUrlPiece g] - | StyleInvertLightness i <- mapStyleOp - = T.concat ["invert_lightness:", toUrlPiece i] - | StyleVisibility e <- mapStyleOp - = T.concat ["visibility:", toUrlPiece e] - | StyleColor r g b <- mapStyleOp - = T.pack $ "color:0x" ++ hexString r ++ hexString g ++ hexString b - | StyleWeight w <- mapStyleOp - = T.concat ["weight:", toUrlPiece w] + toUrlPiece mapStyleOp + | StyleHue r g b <- mapStyleOp + = T.pack $ "hue:0x" ++ hexString r ++ hexString g ++ hexString b + | StyleLightness l <- mapStyleOp + = T.concat ["lightness:", toUrlPiece l] + | StyleSaturation s <- mapStyleOp + = T.concat ["saturation:", toUrlPiece s] + | StyleGamma g <- mapStyleOp + = T.concat ["gamma:", toUrlPiece g] + | StyleInvertLightness i <- mapStyleOp + = T.concat ["invert_lightness:", toUrlPiece i] + | StyleVisibility e <- mapStyleOp + = T.concat ["visibility:", toUrlPiece e] + | StyleColor r g b <- mapStyleOp + = T.pack $ "color:0x" ++ hexString r ++ hexString g ++ hexString b + | StyleWeight w <- mapStyleOp + = T.concat ["weight:", toUrlPiece w] instance ToHttpApiData [MapStyleOp] where - toUrlPiece ops = T.concat $ intersperse "|" $ map toUrlPiece ops + toUrlPiece ops = T.concat $ intersperse "|" $ map toUrlPiece ops -- | Visibility data Visibility - = On - | Off - | Simplified -- ^ Removes some, not all, style features - deriving (Eq, Show) + = On + | Off + | Simplified -- ^ Removes some, not all, style features + deriving (Eq, Show) instance ToHttpApiData Visibility where - toUrlPiece visibility = case visibility of - On -> "on" - Off -> "off" - Simplified -> "simplified" + toUrlPiece visibility = case visibility of + On -> "on" + Off -> "off" + Simplified -> "simplified" -- | Map type data MapType - = RoadMap -- ^ The default value. - | Satellite - | Hybrid - | Terrain - deriving (Eq, Show) + = RoadMap -- ^ The default value. + | Satellite + | Hybrid + | Terrain + deriving (Eq, Show) instance ToHttpApiData MapType where - toUrlPiece mapType = case mapType of - RoadMap -> "roadmap" - Satellite -> "satellite" - Hybrid -> "hybrid" - Terrain -> "terrain" + toUrlPiece mapType = case mapType of + RoadMap -> "roadmap" + Satellite -> "satellite" + Hybrid -> "hybrid" + Terrain -> "terrain" -- | Markers data Markers = Markers (Maybe MarkerStyle) [Location] - deriving (Eq, Show) + deriving (Eq, Show) instance ToHttpApiData Markers where - toUrlPiece (Markers markerStyleOpt ls) - | Nothing <- markerStyleOpt - = toUrlPiece ls - | Just (StdMarkerStyle Nothing Nothing Nothing) <- markerStyleOpt - = toUrlPiece ls - | Just markerStyle <- markerStyleOpt - = case ls of - [] -> toUrlPiece markerStyle - _ -> T.concat [toUrlPiece markerStyle, "|", toUrlPiece ls] + toUrlPiece (Markers markerStyleOpt ls) + | Nothing <- markerStyleOpt + = toUrlPiece ls + | Just (StdMarkerStyle Nothing Nothing Nothing) <- markerStyleOpt + = toUrlPiece ls + | Just markerStyle <- markerStyleOpt + = case ls of + [] -> toUrlPiece markerStyle + _ -> T.concat [toUrlPiece markerStyle, "|", toUrlPiece ls] -- | Marker style data MarkerStyle - = StdMarkerStyle - { markerSize :: Maybe MarkerSize - , markerColor :: Maybe MarkerColor - , markerLabel :: Maybe MarkerLabel - } - | CustomIcon - { icon :: URI - , anchor :: Maybe Anchor - } - deriving (Eq, Show) + = StdMarkerStyle + { markerSize :: Maybe MarkerSize + , markerColor :: Maybe MarkerColor + , markerLabel :: Maybe MarkerLabel + } + | CustomIcon + { icon :: URI + , anchor :: Maybe Anchor + } + deriving (Eq, Show) instance ToHttpApiData MarkerStyle where - toUrlPiece markerStyle - | StdMarkerStyle ms mc ml <- markerStyle - = let size' = T.append "size:" . toUrlPiece <$> ms - color' = T.append "color:" . toUrlPiece <$> mc - label' = T.append "label:" . toUrlPiece <$> ml - opts = catMaybes [size', color', label'] - in T.concat $ intersperse "|" opts - | CustomIcon url ma <- markerStyle - = let icon' = T.concat ["icon:", toUrlPiece $ uriToString id url ""] - in case ma of - Nothing -> icon' - Just a -> T.concat [icon', "|", "anchor:", toUrlPiece a] + toUrlPiece markerStyle + | StdMarkerStyle ms mc ml <- markerStyle + = let size' = T.append "size:" . toUrlPiece <$> ms + color' = T.append "color:" . toUrlPiece <$> mc + label' = T.append "label:" . toUrlPiece <$> ml + opts = catMaybes [size', color', label'] + in T.concat $ intersperse "|" opts + | CustomIcon url ma <- markerStyle + = let icon' = T.concat ["icon:", toUrlPiece $ uriToString id url ""] + in case ma of + Nothing -> icon' + Just a -> T.concat [icon', "|", "anchor:", toUrlPiece a] -- | Marker size data MarkerSize - = Tiny - | Mid - | Small - deriving (Eq, Show) + = Tiny + | Mid + | Small + deriving (Eq, Show) instance ToHttpApiData MarkerSize where - toUrlPiece markerSize' = case markerSize' of - Tiny -> "tiny" - Mid -> "mid" - Small -> "small" + toUrlPiece markerSize' = case markerSize' of + Tiny -> "tiny" + Mid -> "mid" + Small -> "small" -- | Marker colour data MarkerColor - = MarkerColor Word8 Word8 Word8 - | StdMarkerColor StdColor - deriving (Eq, Show) + = MarkerColor Word8 Word8 Word8 + | StdMarkerColor StdColor + deriving (Eq, Show) instance ToHttpApiData MarkerColor where - toUrlPiece (MarkerColor r g b) = T.pack $ "0x" ++ hexString r ++ hexString g - ++ hexString b - toUrlPiece (StdMarkerColor stdColor) = toUrlPiece stdColor + toUrlPiece (MarkerColor r g b) = T.pack $ "0x" ++ hexString r ++ hexString g + ++ hexString b + toUrlPiece (StdMarkerColor stdColor) = toUrlPiece stdColor -- | Standard colours data StdColor - = Black - | Brown - | Green - | Purple - | Yellow - | Blue - | Gray - | Orange - | Red - | White - deriving (Eq, Show) + = Black + | Brown + | Green + | Purple + | Yellow + | Blue + | Gray + | Orange + | Red + | White + deriving (Eq, Show) instance ToHttpApiData StdColor where - toUrlPiece stdColor = case stdColor of - Black -> "black" - Brown -> "brown" - Green -> "green" - Purple -> "purple" - Yellow -> "yellow" - Blue -> "blue" - Gray -> "gray" - Orange -> "orange" - Red -> "red" - White -> "white" + toUrlPiece stdColor = case stdColor of + Black -> "black" + Brown -> "brown" + Green -> "green" + Purple -> "purple" + Yellow -> "yellow" + Blue -> "blue" + Gray -> "gray" + Orange -> "orange" + Red -> "red" + White -> "white" -- | Marker label character newtype MarkerLabel = MarkerLabel Char - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, ToHttpApiData) -- | Anchor data Anchor - = AnchorPoint Int Int - | StdAnchor StdAnchor - deriving (Eq, Show) + = AnchorPoint Int Int + | StdAnchor StdAnchor + deriving (Eq, Show) instance ToHttpApiData Anchor where - toUrlPiece anchor' - | AnchorPoint x y <- anchor' - = T.pack (show x ++ "," ++ show y) - | StdAnchor stdAnchor <- anchor' - = toUrlPiece stdAnchor + toUrlPiece anchor' + | AnchorPoint x y <- anchor' + = T.pack (show x ++ "," ++ show y) + | StdAnchor stdAnchor <- anchor' + = toUrlPiece stdAnchor -- | Standard anchor points data StdAnchor - = AnchorTop - | AnchorBottom - | AnchorLeft - | AnchorRight - | AnchorCenter - | AnchorTopLeft - | AnchorTopRight - | AnchorBottomLeft - | AnchorBottomRight - deriving (Eq, Show) + = AnchorTop + | AnchorBottom + | AnchorLeft + | AnchorRight + | AnchorCenter + | AnchorTopLeft + | AnchorTopRight + | AnchorBottomLeft + | AnchorBottomRight + deriving (Eq, Show) instance ToHttpApiData StdAnchor where - toUrlPiece stdAnchor = case stdAnchor of - AnchorTop -> "top" - AnchorBottom -> "bottom" - AnchorLeft -> "left" - AnchorRight -> "right" - AnchorCenter -> "center" - AnchorTopLeft -> "topleft" - AnchorTopRight -> "topright" - AnchorBottomLeft -> "bottomleft" - AnchorBottomRight -> "bottomright" + toUrlPiece stdAnchor = case stdAnchor of + AnchorTop -> "top" + AnchorBottom -> "bottom" + AnchorLeft -> "left" + AnchorRight -> "right" + AnchorCenter -> "center" + AnchorTopLeft -> "topleft" + AnchorTopRight -> "topright" + AnchorBottomLeft -> "bottomleft" + AnchorBottomRight -> "bottomright" -- | Path data Path = Path (Maybe PathStyle) [Location] - deriving (Eq, Show) + deriving (Eq, Show) instance ToHttpApiData Path where - toUrlPiece (Path pathStyleOpt ls) - | Nothing <- pathStyleOpt - = toUrlPiece ls - | Just (PathStyle Nothing Nothing Nothing Nothing) <- pathStyleOpt - = toUrlPiece ls - | Just pathStyle <- pathStyleOpt - = case ls of - [] -> toUrlPiece pathStyle - _ -> T.concat [toUrlPiece pathStyle, "|", toUrlPiece ls] + toUrlPiece (Path pathStyleOpt ls) + | Nothing <- pathStyleOpt + = toUrlPiece ls + | Just (PathStyle Nothing Nothing Nothing Nothing) <- pathStyleOpt + = toUrlPiece ls + | Just pathStyle <- pathStyleOpt + = case ls of + [] -> toUrlPiece pathStyle + _ -> T.concat [toUrlPiece pathStyle, "|", toUrlPiece ls] -- | Path style: a geodesic path follows the curvature of the Earth. data PathStyle = PathStyle - { pathWeight :: Maybe PathWeight -- ^ The default value is 5. - , pathColor :: Maybe PathColor - , pathFillColor :: Maybe PathColor - , pathGeodesic :: Maybe PathGeodesic -- ^ The default value is false. - } deriving (Eq, Show) + { pathWeight :: Maybe PathWeight -- ^ The default value is 5. + , pathColor :: Maybe PathColor + , pathFillColor :: Maybe PathColor + , pathGeodesic :: Maybe PathGeodesic -- ^ The default value is false. + } deriving (Eq, Show) instance ToHttpApiData PathStyle where - toUrlPiece (PathStyle mw mc mfc mg) = - T.concat $ intersperse "|" opts - where - weightUrl = T.append "weight:" . toUrlPiece <$> mw - colorUrl = T.append "color:" . toUrlPiece <$> mc - fillColorUrl = T.append "fillcolor:" . toUrlPiece <$> mfc - geodesicUrl = T.append "geodesic:" . toUrlPiece <$> mg - opts = catMaybes [weightUrl, colorUrl, fillColorUrl, - geodesicUrl] + toUrlPiece (PathStyle mw mc mfc mg) = + T.concat $ intersperse "|" opts + where + weightUrl = T.append "weight:" . toUrlPiece <$> mw + colorUrl = T.append "color:" . toUrlPiece <$> mc + fillColorUrl = T.append "fillcolor:" . toUrlPiece <$> mfc + geodesicUrl = T.append "geodesic:" . toUrlPiece <$> mg + opts = catMaybes [weightUrl, colorUrl, fillColorUrl, geodesicUrl] -- | Path weight: in pixels. newtype PathWeight = PathWeight Int - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, ToHttpApiData) -- | Path colour data PathColor - = PathColor Word8 Word8 Word8 - | PathColorAlpha Word8 Word8 Word8 Word8 - | StdPathColor StdColor - deriving (Eq, Show) + = PathColor Word8 Word8 Word8 + | PathColorAlpha Word8 Word8 Word8 Word8 + | StdPathColor StdColor + deriving (Eq, Show) instance ToHttpApiData PathColor where - toUrlPiece (PathColor r g b) = T.pack $ "0x" ++ hexString r ++ hexString g - ++ hexString b - toUrlPiece (PathColorAlpha r g b a) = T.pack $ "0x" ++ hexString r ++ - hexString g ++ hexString b ++ hexString a - toUrlPiece (StdPathColor stdColor) = toUrlPiece stdColor + toUrlPiece (PathColor r g b) = T.pack $ "0x" ++ hexString r ++ hexString g + ++ hexString b + toUrlPiece (PathColorAlpha r g b a) = T.pack $ "0x" ++ hexString r ++ + hexString g ++ hexString b ++ hexString a + toUrlPiece (StdPathColor stdColor) = toUrlPiece stdColor -- | Path is geodesic newtype PathGeodesic = PathGeodesic Bool - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, ToHttpApiData) -- | Visible locations newtype Visible = Visible [Location] - deriving (Eq, Show, ToHttpApiData) + deriving (Eq, Show, 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 + = "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 @@ -587,22 +591,22 @@ api :: Proxy GoogleMapsStaticAPI api = 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' = client api -- | Retrieve a static map. NB: The use of the Google Maps Static API services @@ -612,79 +616,93 @@ -- 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 - mgr - key - secretOpt - centerOpt - zoomOpt - size - scaleOpt - formatOpt - mapStyles - mapTypeOpt - languageOpt - regionOpt - markerss - paths - visibleOpt - = case secretOpt of - Nothing -> runClientM (eval staticmap' Nothing) + mgr + key + secretOpt + centerOpt + zoomOpt + size + scaleOpt + formatOpt + mapStyles + mapTypeOpt + languageOpt + regionOpt + markerss + paths + visibleOpt + = case secretOpt of + Nothing -> runClientM (eval staticmap' Nothing) +-- Middleware supported from servant-client-0.20.2 +#if MIN_VERSION_servant_client(0,20,2) + (ClientEnv mgr + googleMapsApis + Nothing + defaultMakeClientRequest + id) -- makeClientRequest supported from servant-client-0.17 -#if MIN_VERSION_servant_client(0,17,0) - (ClientEnv mgr - googleMapsApis - Nothing - defaultMakeClientRequest) +#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) + (ClientEnv mgr googleMapsApis Nothing) #else - (ClientEnv mgr googleMapsApis) + (ClientEnv mgr googleMapsApis) #endif - Just secret -> do - let url = linkURI $ eval (safeLink api api) Nothing - signatureOpt = sign secret googleMapsApis url - runClientM (eval staticmap' signatureOpt) + Just secret -> do + let url = linkURI $ eval (safeLink api api) Nothing + signatureOpt = sign secret googleMapsApis url + runClientM (eval staticmap' signatureOpt) +-- Middleware supported from servant-client-0.20.2 +#if MIN_VERSION_servant_client(0,20,2) + (ClientEnv mgr + googleMapsApis + Nothing + defaultMakeClientRequest + id) -- makeClientRequest supported from servant-client-0.17 -#if MIN_VERSION_servant_client(0,17,0) - (ClientEnv mgr - googleMapsApis - Nothing - defaultMakeClientRequest) +#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) + (ClientEnv mgr googleMapsApis Nothing) #else - (ClientEnv mgr googleMapsApis) + (ClientEnv mgr googleMapsApis) #endif - where - linkURI = linkURI' LinkArrayElementPlain - eval f = f (Just key) centerOpt zoomOpt (Just size) scaleOpt formatOpt - mapStyles mapTypeOpt languageOpt regionOpt markerss paths - visibleOpt + where + linkURI = linkURI' LinkArrayElementPlain + eval f = f (Just key) centerOpt zoomOpt (Just size) scaleOpt formatOpt + mapStyles mapTypeOpt languageOpt regionOpt markerss paths + visibleOpt sign :: Secret -> BaseUrl -> URI -> Maybe Signature sign (Secret secret) baseUrl url = do - secret' <- either (const Nothing) Just (decode $ encodeUtf8 secret) - let url' = UTF8.fromString $ baseUrlPath baseUrl ++ "/" ++ uriToString id url "" - signature = hmac secret' url' :: HMAC SHA1 - signature' = decodeUtf8 $ encode $ convert signature - return $ Signature signature' + secret' <- either (const Nothing) Just (decode $ encodeUtf8 secret) + let url' = UTF8.fromString $ baseUrlPath baseUrl ++ "/" ++ uriToString id url "" + signature = hmac secret' url' :: HMAC SHA1 + signature' = decodeUtf8 $ encode $ convert signature + return $ Signature signature'
stack.yaml view
@@ -1,6 +1,1 @@-resolver: lts-20.23 # GHC 9.2.7 -compiler: ghc-9.2.8 # No Stackage snapshot as at 2023-06-03 - -flags: - ansi-terminal: - win32-2-13-1: false +snapshot: nightly-2024-10-27 # GHC 9.8.3