Version 0.0.0.0

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

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