module Model.GeoNames
( GeoName(..)
, geoNameUS
, parseGeoNameRef
, lookupGeoName
, parseGeoName
) where
import Control.Monad (guard)
import qualified Data.ByteString.Char8 as BSC
import Data.Int (Int64)
import Data.List (stripPrefix)
import Data.Maybe (fromJust, fromMaybe, listToMaybe)
import qualified Data.Text as T
import qualified Network.HTTP.Client as HC
import qualified JSON
import HTTP.Client
import Model.Id.Types
type instance IdType GeoName = Int64
data GeoName = GeoName
{ geoNameId :: !(Id GeoName)
, geoName :: !T.Text
}
geoNameUS :: GeoName
geoNameUS = GeoName
{ geoNameId = Id 6252001
, geoName = "United States"
}
parseGeoNameRef :: String -> Maybe (Id GeoName)
parseGeoNameRef s = listToMaybe $ do
(i, r) <- reads $ fromMaybe s (stripPrefix "http://sws.geonames.org/" s)
guard (null r || r == "/")
return $ Id i
parseGeoName :: JSON.Value -> JSON.Parser GeoName
parseGeoName = JSON.withObject "geoname" $ \j -> do
i <- j JSON..: "geonameId"
n <- j JSON..: "name"
return GeoName
{ geoNameId = Id i
, geoName = n
}
geoNameReq :: HC.Request
geoNameReq = (fromJust $ HC.parseRequest "http://api.geonames.org/getJSON")
{ HC.cookieJar = Nothing }
lookupGeoName :: Id GeoName -> HTTPClient -> IO (Maybe GeoName)
lookupGeoName (Id i) hcm = do
j <- httpRequestJSON req hcm
return $ JSON.parseMaybe parseGeoName =<< j
where req = HC.setQueryString [("geonameId", Just $ BSC.pack $ show i), ("username", Just "databrary")] geoNameReq