Haskell Scotty ‘Home.main’ 应用于太少的参数

Haskell Scotty ‘Home.main’ is applied to too few arguments

我需要用 Haskell 的 Scotty 启动我的非常简单的网络应用程序,但我似乎无法让 IO () ReaderT 工作。我是基于我在网上找到的另一个例子,并且对 Monads 和 Haskell 总体来说还是个新手。

我的 IDE 抛出了这个错误:

Couldn't match expected type ‘IO t0’
              with actual type ‘(m0 Network.Wai.Internal.Response
                                 -> IO Network.Wai.Internal.Response)
                                -> IO ()’
• Probable cause: ‘Home.main’ is applied to too few arguments
  In the expression: Home.main
  When checking the type of the IO action ‘main’

它也在抛出这个,但我认为一旦我修复了另一个它就应该修复了

Ambiguous occurrence ‘main’
    It could refer to either ‘Home.main’,
                             imported from ‘Platform.Home’ at Main.hs:16:1-28
                          or ‘Main.main’, defined at Main.hs:28:1

我在这里留下了所需的代码,如果还有什么我应该展示的,请告诉我。 在“Main.hs”中:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Main 
      ( main
      ) where

import Control.Monad (join)
import Control.Applicative ((<$>))

import Core.Item.Controller (routes)
import Core.Item.Controller as ItemController
import Core.Item.Service as ItemService
import Core.Item.DAO as ItemDAO

import Platform.Postgres as Postgres
import Platform.Home as Home

import Data.Maybe (fromMaybe)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->))
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import Web.Scotty (middleware, scotty)
import Language.Haskell.TH (Type(AppT))
import ClassyPrelude

main :: IO ()
main = do
  pgEnv <- Postgres.init
  let runner app = flip runReaderT pgEnv $ unAppT app
  Home.main runner

type Environment = Postgres.Env

newtype AppT a = AppT
  { unAppT :: ReaderT Environment IO a
  } deriving  (Applicative, Functor, Monad, MonadIO, MonadReader Environment)

instance ItemController.Service AppT where
  getItem = ItemService.getItem
  getItems = ItemService.getItems
  createItem = ItemService.createItem

instance ItemService.ItemRepo AppT where
  findItems = ItemDAO.findItems
  addItem = ItemDAO.addItem

instance ItemService.TimeRepo AppT where
  currentTime = liftIO getCurrentTime

在“Postgres.hs”

type Env = Pool Connection

type Postgres r m = (MonadReader r m, Has Env r, MonadIO m)
    
init :: IO Env
init = do
  pool <- acquirePool
  migrateDb pool
  return pool

这是我的“Home.hs”:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}

module Platform.Home
    ( main
    ) where

import ClassyPrelude (MonadIO, LText, fromMaybe, readMay)
import Web.Scotty.Trans
import Network.HTTP.Types.Status
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import Network.Wai.Handler.Warp (defaultSettings, setPort)
import Network.Wai (Response)
import Network.Wai.Middleware.Cors

import qualified Core.Item.Controller as ItemController
import System.Environment (lookupEnv)

type App r m = (ItemController.Service m, MonadIO m)

main :: (App r m) => (m Response -> IO Response) -> IO ()
main runner = do
  port <- acquirePort
  mayTLSSetting <- acquireTLSSetting
  case mayTLSSetting of
    Nothing ->
      scottyT port runner routes
    Just tlsSetting -> do
      app <- scottyAppT runner routes
      runTLS tlsSetting (setPort port defaultSettings) app
  where
    acquirePort = do
      port <- fromMaybe "" <$> lookupEnv "PORT"
      return . fromMaybe 3000 $ readMay port
    acquireTLSSetting = do
      env <- (>>= readMay) <$> lookupEnv "ENABLE_HTTPS"
      let enableHttps = fromMaybe True env
      return $ if enableHttps
        then Just $ tlsSettings "secrets/tls/certificate.pem" "secrets/tls/key.pem"
        else Nothing

routes :: (App r m) => ScottyT LText m ()
routes = do
  -- middlewares
  middleware $ cors $ const $ Just simpleCorsResourcePolicy
    { corsRequestHeaders = "Authorization":simpleHeaders
    , corsMethods = "PUT":"DELETE":simpleMethods
    }
  options (regex ".*") $ return ()

  -- errors
  defaultHandler $ \str -> do
    status status500
    json str

  -- feature routes
  ItemController.routes
  
  -- health
  get "/api/health" $
    json True

其实错误是有关联的。在Main.hs中,将Homeimport改为:

import qualified Platform.Home as Home
       ^^^^^^^^^-- add this

它应该可以修复这两个错误。以下最小示例给出了同一对错误:

-- contents of Home.hs
module Home where
main :: (Int -> Int) -> IO ()
main = undefined

-- contents of Main.hs
import Home
main = Home.main id

但如果您将 import Home 更改为 import qualified Home

问题似乎是 GHC 试图将 Home.main 作为程序的 main 函数进行类型检查(可能仅仅是因为它是第一个定义的,在定义 Main.main 在模块的主体中​​),它会生成此额外的错误消息,因为 Home.main 的类型与 main 函数所需的 IO t 签名不匹配。这发生在它注意到 main 有两个定义(即“模棱两可的发生”错误)之前,并且它的类型检查错误。