Yesod is using first case as return type

Question

thanks for your time:

The idea is that the request may include either

• a apple with code ( represented in integer )
• apples with codes

the handler will branch base on the input

• if it is an apple then return a string
• if it is apples ,then return a list of strings

the issue is , why Haskell compiler complains that ,it expects [string] instead of [[strings]] as return value ?

when I switch lines of

Apple code -> ["APPLE"++show code]
Apples codes -> map (\x -> ["APPLE"++ show x]) codes

into

Apples codes -> map (\x -> ["APPLE"++ show x]) codes
Apple code -> ["APPLE"++show code]

Now haskell is expecting [[string]] instead of [string] .

Is it Yesod make first case as DEFAULT return type of that handler ?

code of interest:

data Fruit = Apple Int
           | Apples [Int]

data Req = Req {
   apple :: Fruit
}
$(deriveJSON defaultOptions ''Req)

data App = App

mkYesod "App" [parseRoutes|
 /show ShowAppleR POST
|]

instance Yesod App where
  yesodMiddleware = defaultYesodMiddleware

postShowAppleR :: Handler Value
postShowAppleR =  do
  runReq <- requireCheckJsonBody :: Handler Req
  returnJson $
      case (apple runReq) of
        Apple code -> ["APPLE"++show code]
        Apples codes -> map (\x -> ["APPLE"++ show x]) codes

full code :

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
module Main2 where

import Data.Aeson       hiding (json)
import Data.Monoid      ((<>))
import Data.Text        (Text, pack)
import GHC.Generics
import Data.ByteString.Lazy.Char8 (unpack)

import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types

import Yesod
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import Network.Wai.Middleware.Cors


data Fruit = Apple Int
           | Apples [Int]

data Req = Req {
   apple :: Fruit
}
$(deriveJSON defaultOptions ''Req)

data App = App

mkYesod "App" [parseRoutes|
 /show ShowAppleR POST
|]

instance Yesod App where
  yesodMiddleware = defaultYesodMiddleware

postShowAppleR :: Handler Value
postShowAppleR =  do
  runReq <- requireCheckJsonBody :: Handler Req
  returnJson $
      case (apple runReq) of
        Apple code -> ["APPLE"++show code]
        Apples codes -> map (\x -> ["APPLE"++ show x]) codes


main :: IO ()
main =
  do
   app <- toWaiApp App
   run 8084 $ defaultMiddlewaresNoLogging
            $ cors (const $ Just $ simpleCorsResourcePolicy
                                    { corsOrigins = Nothing
                                    , corsMethods = ["OPTIONS", "GET", "PUT", "POST"]
                                    , corsRequestHeaders = simpleHeaders })
            $ app

Answer 1

The root cause is that returnJson looks take the FIRST statement as return type. This issue can be solved by using two returnJson to wrap two return types.

postShowAppleR :: Handler Value
postShowAppleR =  do
  runReq <- requireCheckJsonBody :: Handler Req
  case (apple runReq) of
    Apples codes -> returnJson $ map (\x -> ["APPLE"++ show x]) codes
    Apple code -> returnJson $ ["APPLE"++show code]