4

コンジットと aeson の探索を続けます。このYesod bookValueの (わずかに変更された) コード スニペットの代わりに、独自のデータ型を使用するにはどうすればよいでしょうか。

{-# 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→IO JSONRequestに変更したい。fromJSON の独自の派生インスタンスを使用するようにパーサーに指示するにはどうすればよいですか?

型宣言を追加して、json の多形的な戻り値の型を祈ってみましたが、厳密には Value 用であることに気付きました。

4

1 に答える 1

3

型を見るだけで、からの結果を処理fmap する 必要があるだけではありませんか? 適切な署名があれば、次のものが必要です。fromJSONjsondispatch

-- 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、エラー ケースも処理しています。

于 2012-11-08T16:01:24.890 に答える