Search code examples
haskellmonadsscotty

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


I need to start up my very simple webapp with Haskell's Scotty and I just can't seem to get the IO () ReaderT stuff workinng. I am basing this off of another example I found online, and am pretty new to Monads and Haskell overall.

My IDE is throwing this error:

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’

It is also throwing this one but I think it should get fixed once I fixed the other one

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

I am leaving here the needed code, if there is anything else I should show please let me know. In "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

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

And this is my "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

Solution

  • Actually, the errors are related. In Main.hs, change the import of Home to:

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

    and it should fix both errors. The following minimal example gives the same pair of errors:

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

    but works if you change import Home to import qualified Home.

    The issue appears to be that GHC tries to type-check Home.main as the program's main function (perhaps simply because it was the first one defined, having been imported before the definition of Main.main in the body of the module), and it generates this extra error message because Home.main's type doesn't match the required signature of IO t for a main function. This happens before it gets around to noticing that there are two definitions of main (i.e., the "ambiguous occurrence" error), and it's typechecked the wrong one.