Question

继续探索管道和aeson，如何在Yesod book的这个（略微修改过的）代码片段中使用我自己的数据类型代替Value。

{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Network.Wai (Response, responseLBS, Application, requestBody)
import Network.HTTP.Types (status200, status400)
import Network.Wai.Handler.Warp (run)
import Data.Aeson.Parser (json)
import Data.Conduit.Attoparsec (sinkParser)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value(..), encode, object, (.=))
import Control.Exception (SomeException)
import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, ($$))
import Control.Exception.Lifted (handle)

import qualified Data.HashMap.Strict as M
import Data.Aeson.TH (deriveJSON)

-- I ADDED THIS

data JSONRequest = JSONRequest {
    command :: ByteString,
    params :: M.HashMap ByteString ByteString
}

deriveJSON id ''JSONRequest

-- END OF WHAT I ADDED

main :: IO ()
main = run 3000 app

app :: Application
app req = handle invalidJson $ do
    value <- requestBody req $$ sinkParser json
    newValue <- liftIO $ dispatch value
    return $ responseLBS
        status200
        [("Content-Type", "application/json")]
        $ encode newValue

invalidJson :: SomeException -> ResourceT IO Response
invalidJson ex = return $ responseLBS
    status400
    [("Content-Type", "application/json")]
    $ encode $ object
        [ ("message" .= show ex)
        ]

-- Application-specific logic would go here.
dispatch :: Value -> IO Value
dispatch = return

基本上，我想将dispatch的类型更改为JSONRequest - ＆gt; IO JSONRequest。如何告诉解析器使用我自己的fromJSON派生实例？

我尝试添加一个类型声明，在json上祈祷多态返回类型，但我意识到它仅限于Value。

Answer 1

只是查看类型，您是否只需fmap fromJSON来自json的结果？使用dispatch的合适签名，我们只需要：

-- import Data.Aeson app :: Application app req = handle invalidJson $ do result <- requestBody req $$ sinkParser (fmap fromJSON json) next_result <- liftIO $ dispatch result return $ responseLBS status200 [("Content-Type", "application/json")] $ encode next_result dispatch :: Result JSONRequest -> IO JSONRequest dispatch (Error str) = undefined dispatch (Success jsonreq) = return jsonreq

但也许这样写的更清楚一点：

-- import Data.Aeson -- import qualified Data.Attoparsec as Atto toRequest :: Value -> Result JSONRequest toRequest = fromJSON -- specialized now to your fromJSON jsonRequestParser :: Atto.Parser (Result JSONRequest) jsonRequestParser = fmap toRequest json app :: Application app req = handle invalidJson $ do result <- requestBody req $$ sinkParser jsonRequestParser next_result <- liftIO $ dispatch result return $ responseLBS status200 [("Content-Type", "application/json")] $ encode next_result dispatch :: Result JSONRequest -> IO JSONRequest dispatch (Error str) = undefined dispatch (Success jsonreq) = return jsonreq

我让解析器返回Result JSONRequest，因此dispatch也处理错误情况，这可能意味着您需要以某种方式处理异常处理？

Aeson deriveJSON结合导管sinkParser

1 个答案: