Блог

Мне нужно запустить мое очень простое веб-приложение с помощью Haskell’s Scotty, и я просто не могу заставить IO () ReaderT работать. Я основываю это на другом примере, который я нашел в Интернете, и я довольно новичок в Monads и Haskell в целом.

Моя среда разработки выдает эту ошибку:

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

gt;))
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 "" <

gt; lookupEnv "PORT"

      return . fromMaybe 3000 $ readMay port

    acquireTLSSetting = do

      env <- (>>= readMay) <

gt; 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 , измените значение import Home на:

 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 , потому что тип не соответствует требуемой сигнатуредля IO t main функции. Это происходит до того, как он замечает, что существует два определения main (т. Е. Ошибка «неоднозначного возникновения»), и он проверил неправильный тип.