packages feed

realdentalcosts-0.1.0.0: src/RealDentalCosts/Api.hs

{-# LANGUAGE OverloadedStrings #-}
-- | Client for the Real Dental Costs Open Data API
-- (<https://realdentalcosts.com/en/api/>).
--
-- The API is static JSON (CC BY 4.0) covering US dental procedure cash price
-- ranges by state (<https://realdentalcosts.com/en/root-canal/>,
-- <https://realdentalcosts.com/en/dentures/>,
-- <https://realdentalcosts.com/en/dental-implants/>), state cost indexes and
-- Medicaid paid amounts per CDT code from the HHS/CMS T-MSIS files
-- (<https://realdentalcosts.com/en/medicaid-dental-coverage-by-state/>).
-- Every payload carries a @provenance@ block; see
-- <https://realdentalcosts.com/en/methodology/>.
module RealDentalCosts.Api
  ( baseUrl
  , Provenance (..)
  , PriceRange (..)
  , StatePrice (..)
  , Procedure (..)
  , MedicaidStats (..)
  , MedicaidState (..)
  , Medicaid (..)
  , getProcedure
  , getState
  , getMedicaid
  , getJSON
  , stateRow
  ) where

import Data.Aeson (FromJSON (..), Value, withObject, (.:), (.:?), eitherDecode)
import Data.Char (toLower, toUpper)
import Data.List (find)
import Data.Text (Text)
import Network.HTTP.Simple (getResponseBody, getResponseStatusCode, httpLBS, parseRequest, setRequestHeader)

-- | Production API root.
baseUrl :: String
baseUrl = "https://realdentalcosts.com/api/v1"

-- | Where a figure comes from and how much to trust it.
data Provenance = Provenance
  { provBasis      :: Text     -- ^ "observed" or "estimated"
  , provModeled    :: Bool
  , provConfidence :: Int      -- ^ 0-100
  , provSampleN    :: Maybe Int
  , provPeriod     :: Maybe Text
  } deriving (Show, Eq)

instance FromJSON Provenance where
  parseJSON = withObject "Provenance" $ \o ->
    Provenance <$> o .: "basis" <*> o .: "modeled" <*> o .: "confidence"
               <*> o .:? "sample_n" <*> o .:? "period"

data PriceRange = PriceRange { lowUsd :: Int, avgUsd :: Int, highUsd :: Int }
  deriving (Show, Eq)

instance FromJSON PriceRange where
  parseJSON = withObject "PriceRange" $ \o ->
    PriceRange <$> o .: "low_usd" <*> o .: "avg_usd" <*> o .: "high_usd"

data StatePrice = StatePrice
  { spState :: Text, spCode :: Text, spLow :: Int, spAvg :: Int, spHigh :: Int, spConfidence :: Int }
  deriving (Show, Eq)

instance FromJSON StatePrice where
  parseJSON = withObject "StatePrice" $ \o ->
    StatePrice <$> o .: "state" <*> o .: "code" <*> o .: "low_usd" <*> o .: "avg_usd"
               <*> o .: "high_usd" <*> o .: "confidence"

-- | Payload of @/procedure/{slug}.json@.
data Procedure = Procedure
  { procSlug :: Text, procLabel :: Text, procBasis :: Text
  , procProvenance :: Provenance, procNational :: PriceRange, procByState :: [StatePrice] }
  deriving (Show, Eq)

instance FromJSON Procedure where
  parseJSON = withObject "Procedure" $ \o ->
    Procedure <$> o .: "slug" <*> o .: "label" <*> o .: "basis" <*> o .: "provenance"
              <*> o .: "national" <*> o .: "by_state"

data MedicaidStats = MedicaidStats
  { msPaidPerLine :: Double, msMedianCell :: Double, msLines :: Int, msPatients :: Int, msProviders :: Int }
  deriving (Show, Eq)

instance FromJSON MedicaidStats where
  parseJSON = withObject "MedicaidStats" $ \o ->
    MedicaidStats <$> o .: "paid_per_line_wavg" <*> o .: "median_cell" <*> o .: "lines"
                  <*> o .: "patients" <*> o .: "n_providers"

data MedicaidState = MedicaidState
  { mstState :: Text, mstCode :: Text, mstQuality :: Text, mstConfidence :: Int, mstLatest :: Maybe MedicaidStats }
  deriving (Show, Eq)

instance FromJSON MedicaidState where
  parseJSON = withObject "MedicaidState" $ \o ->
    MedicaidState <$> o .: "state" <*> o .: "code" <*> o .: "quality_flag" <*> o .: "confidence" <*> o .:? "latest"

-- | Payload of @/medicaid/{cdt}.json@ (e.g. @D3330@ molar root canal).
data Medicaid = Medicaid
  { mdCode :: Text, mdLabel :: Text, mdProvenance :: Provenance, mdNational :: MedicaidStats
  , mdStates :: [MedicaidState], mdCaveats :: [Text] }
  deriving (Show, Eq)

instance FromJSON Medicaid where
  parseJSON = withObject "Medicaid" $ \o ->
    Medicaid <$> o .: "code" <*> o .: "label" <*> o .: "provenance" <*> o .: "national"
             <*> o .: "states" <*> o .: "caveats"

-- | Fetch and decode any endpoint path (e.g. @"/states.json"@).
getJSON :: FromJSON a => String -> IO (Either String a)
getJSON path = do
  req <- setRequestHeader "User-Agent" ["realdentalcosts-hs/0.1"] <$> parseRequest (baseUrl ++ path)
  resp <- httpLBS req
  let code = getResponseStatusCode resp
  pure $ if code == 404 then Left ("not found: " ++ path)
         else if code < 200 || code > 299 then Left ("HTTP " ++ show code ++ ": " ++ path)
         else eitherDecode (getResponseBody resp)

-- | One procedure by slug (e.g. @"root-canal"@, @"dentures"@, @"dental-implant"@).
getProcedure :: String -> IO (Either String Procedure)
getProcedure slug = getJSON ("/procedure/" ++ map toLower slug ++ ".json")

-- | One state by two-letter code; returned as a raw JSON 'Value'.
getState :: String -> IO (Either String Value)
getState code = getJSON ("/state/" ++ map toLower code ++ ".json")

-- | Medicaid paid amounts per claim line for a CDT code.
getMedicaid :: String -> IO (Either String Medicaid)
getMedicaid cdt = getJSON ("/medicaid/" ++ map toUpper cdt ++ ".json")

-- | Find a state's row in a procedure table.
stateRow :: Text -> Procedure -> Maybe StatePrice
stateRow code = find ((== code) . spCode) . procByState