Haskell解析CoinMarketCap接口含动态tokenId键的JSON方法

我编写了一个Haskell的query函数，调用CoinMarketCap的getV1CryptocurrencyQuotesLatest接口获取最新代币价格，函数接收token id作为入参，例如ADA对应的id为2010，函数实现代码如下：

import Data.Aeson
import Network.HTTP.Req

newtype Rate = Rate Double

query :: Int -> IO (Either Text Rate)
query tokenId = 
    let
        url = https queryPrefix /: "v1" /: "cryptocurrency" /: "quotes" /: "latest"
        idParam = "id" =: tokenId
        options = standardHeader <> idParam
    in
        runReq defaultHttpConfig $ do
            v <- req GET url NoReqBody jsonResponse options
            let responseCode = responseStatusCode v

            if isValidHttpResponse responseCode then do  
                case fromJSON $ responseBody v of
                    Success x -> pure $ Right x
                    Error e -> pure $ Left $ pack $ "Error decoding state: " <> e
            else
                pure $ Left $ pack ("Error with CoinMarketCap query 'Quotes Latest': " <> show responseCode <> ".  " <> show (responseStatusMessage v))              

但接口返回的JSON中data字段下的键是传入的token id字符串，示例返回结构如下：

{"status":
    {"timestamp":"2021-10-24T03:35:01.583Z","error_code":0,"error_message":null,"elapsed":163,"credit_count":1,"notice":null}
,"data":
    {"2010":
        {"id":2010
        ,"name":"Cardano"
        ,"symbol":"ADA"
        ,"slug":"cardano"
        ,"num_market_pairs":302,"date_added":"2017-10-01T00:00:00.000Z"
        ,"tags":["mineable","dpos","pos","platform","research","smart-contracts","staking","binance-smart-chain","cardano-ecosystem"]
        ,"max_supply":45000000000
        ,"circulating_supply":32904527668.666
        ,"total_supply":33250650235.236,"is_active":1
        ,"platform":null
        ,"cmc_rank":4
        ,"is_fiat":0
        ,"last_updated":"2021-10-24T03:33:31.000Z"
        ,"quote":
            {"USD":
                {"price":2.16109553945978
                ,"volume_24h":2048006882.386299
                ,"volume_change_24h":-24.06,"percent_change_1h":0.24896227
                ,"percent_change_24h":0.38920394
                ,"percent_change_7d":-0.97094597
                ,"percent_change_30d":-6.13245906
                ,"percent_change_60d":-21.94246757
                ,"percent_change_90d":63.56901345
                ,"market_cap":71109827972.785
                ,"market_cap_dominance":2.7813
                ,"fully_diluted_market_cap":97249299275.69,"last_updated":"2021-10-24T03:33:31.000Z"}}}}}

我不想在FromJSON实例里写死token id键，比如如下写法非常不灵活：

instance FromJSON Rate where
    parseJSON = withObject "Rate" $ \o -> do
        dataO  <- o .: "data"
        _2010O <- dataO .: "2010" -- #############
        quoteO <- _2010O .: "quote"
        usdO <- quoteO .: "USD"
        price <- usdO .: "price"
        
        pure $ Rate price  

请问怎么实现灵活解析？是否可以将token id参数传入parseJSON？或者有没有Lens-Aeson的通配符匹配方案？

方案1：无额外依赖，手动实现带参数的解析逻辑 #

全局FromJSON实例无法传递动态参数，直接把解析逻辑耦合到请求流程里，把tokenId动态转成key用于取值即可，逻辑清晰可控：

import Data.Aeson
import Data.Aeson.Types (parseEither)
import Data.Text (Text, pack)
import Network.HTTP.Req

newtype Rate = Rate Double

query :: Int -> IO (Either Text Rate)
query tokenId = 
    let
        url = https queryPrefix /: "v1" /: "cryptocurrency" /: "quotes" /: "latest"
        idParam = "id" =: tokenId
        options = standardHeader <> idParam
        -- 接收token id作为参数的解析函数
        parseRate :: Int -> Value -> Either String Rate
        parseRate tid = parseEither $ withObject "APIResponse" $ \o -> do
            dataO <- o .: "data"
            tokenO <- dataO .: pack (show tid) -- 动态生成key取值
            quoteO <- tokenO .: "quote"
            usdO <- quoteO .: "USD"
            price <- usdO .: "price"
            pure $ Rate price
    in
        runReq defaultHttpConfig $ do
            v <- req GET url NoReqBody jsonResponse options
            let responseCode = responseStatusCode v

            if isValidHttpResponse responseCode then do  
                case parseRate tokenId (responseBody v) of
                    Right x -> pure $ Right x
                    Left e -> pure $ Left $ pack $ "Error decoding state: " <> e
            else
                pure $ Left $ pack ("Error with CoinMarketCap query 'Quotes Latest': " <> show responseCode <> ".  " <> show (responseStatusMessage v))              

方案2：用lens-aeson通配符匹配，无需传入token id #

如果每次仅查询单个代币，返回的data字段下永远只有一个子对象，可以用lens-aeson的遍历能力直接跳过key匹配，不需要关心具体的token id值：
首先需要在项目依赖中新增lens和lens-aeson两个包，修改后的代码如下：

import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import Data.Text (Text)
import Network.HTTP.Req

newtype Rate = Rate Double

query :: Int -> IO (Either Text Rate)
query tokenId = 
    let
        url = https queryPrefix /: "v1" /: "cryptocurrency" /: "quotes" /: "latest"
        idParam = "id" =: tokenId
        options = standardHeader <> idParam
    in
        runReq defaultHttpConfig $ do
            v <- req GET url NoReqBody jsonResponse options
            let responseCode = responseStatusCode v

            if isValidHttpResponse responseCode then do  
                let respBody = responseBody v
                -- 直接匹配路径：data下任意子对象 -> quote -> USD -> price
                case respBody ^? key "data" . members . key "quote" . key "USD" . key "price" . _Double of
                    Just price -> pure $ Right $ Rate price
                    Nothing -> pure $ Left $ pack "Failed to parse price from response"
            else
                pure $ Left $ pack ("Error with CoinMarketCap query 'Quotes Latest': " <> show responseCode <> ".  " <> show (responseStatusMessage v))              

该方案仅适用于单代币查询场景，批量查询多代币时不建议使用。

内容的提问来源于stack exchange，提问作者Kwaggy