From 551c0703d7beb3846603abada6b4e61ee108f6ed Mon Sep 17 00:00:00 2001 From: tysonzero Date: Fri, 28 Sep 2018 18:02:21 -0400 Subject: [PATCH] Version 0.0.0.0 --- geocode-census.cabal | 15 +++++++++++++++ src/Geocode/Census.hs | 45 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 geocode-census.cabal create mode 100644 src/Geocode/Census.hs diff --git a/geocode-census.cabal b/geocode-census.cabal new file mode 100644 index 0000000..0479dc7 --- /dev/null +++ b/geocode-census.cabal @@ -0,0 +1,15 @@ +name: geocode-census +version: 0.0.0.0 +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + ghc-options: -O2 -Wall -Werror + default-language: Haskell2010 + build-depends: aeson >=1.2.4 && <1.3 + , base >=4.9.0 && <4.10 + , http-client-tls >=0.3.5 && <0.4 + , servant ==0.13.* + , servant-client ==0.13.* + exposed-modules: Geocode.Census diff --git a/src/Geocode/Census.hs b/src/Geocode/Census.hs new file mode 100644 index 0000000..b917c54 --- /dev/null +++ b/src/Geocode/Census.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DataKinds, OverloadedStrings, TypeApplications, TypeOperators #-} + +module Geocode.Census (geocode) where + +import Prelude hiding (id, zip) + +import Data.Aeson (FromJSON, parseJSON, withObject, (.:)) +import Data.Proxy (Proxy(Proxy)) +import Data.Traversable (for) +import Network.HTTP.Client.TLS (newTlsManager) +import Servant.API (Get, JSON, QueryParam, (:>)) +import Servant.Client (BaseUrl(BaseUrl), ClientM, Scheme(Https), client, mkClientEnv, runClientM) + +geocode :: String -> IO (Maybe (Double, Double)) +geocode addr = do + mgr <- newTlsManager + let env = mkClientEnv mgr baseUrl + r <- runClientM (geocodeClient (Just "Public_AR_Current") (Just addr)) env + pure $ case r of + Right (Output (x : _)) -> Just x + _ -> Nothing + +geocodeClient :: Maybe String -> Maybe String -> ClientM Output +geocodeClient = client $ Proxy @Api + +baseUrl :: BaseUrl +baseUrl = BaseUrl Https "geocoding.geo.census.gov" 443 "geocoder/locations/onelineaddress" + +type Api = QueryParam "benchmark" String + :> QueryParam "address" String + :> Get '[JSON] Output + +newtype Output = Output [(Double, Double)] + deriving Show + +instance FromJSON Output where + parseJSON = withObject "Output" $ \o -> do + r <- o .: "result" + ms <- r .: "addressMatches" + cs <- for ms $ \m -> do + c <- m .: "coordinates" + x <- c .: "x" + y <- c .: "y" + pure (x, y) + pure $ Output cs