Aeson deriveJSON combined with conduit connection

Question

Continuing my research on conduit and eson, how would I use my own data type instead of Value in this (slightly modified) code snippet from Yesod Book .

 {-# 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 

Basically, I want to change the dispatch type to JSONRequest -> IO JSONRequest. How can I tell the parser to use my own derived fromJSON instance?

I tried just adding a type declaration while praying for a polymorphic return type in json, but I realized that this is strictly for Value.

Answer 1

Just looking at the types, you just need to fmap your fromJSON to get the result from json ? With the right signature for dispatch we just need to:

 -- 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 

But maybe this is a little clearer written like this:

 -- 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 

I left the parser returning a Result JSONRequest , so dispatch also handles error cases, which may mean that you need exception handling in some way?