Yesod is using first case as return type-CodePudding

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

CodePudding user response：

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]