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

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

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.

Related

Is there any way to catch all exceptions in scotty without wrapping all of my code in Exception Catching

I would like for my default handler to be able to catch all of the exceptions that my App throws but in order for this to happen I need to manually call raise after manually adding some exception catching around my IO code.
below is an example minimal server:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Lib
( someFunc
) where
import Web.Scotty.Trans
import Control.Monad.Trans
import Control.Monad.Reader
import Control.Monad.Catch
import Control.Monad.Except
import Data.Text.Lazy as TL
data AppEnv = AppEnv
{ appStuff :: String
}
newtype App a = App
{ unApp :: ReaderT AppEnv IO a
} deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv, MonadThrow)
someFunc :: IO ()
someFunc = do
let run a = runReaderT (unApp $ App a) (AppEnv "APPY STUFF")
scottyT 8080 run $ do
defaultHandler $ \(e :: TL.Text) -> do
liftIO $ print "HERE"
liftIO $ print $ showError e
html $ "Something Went Seriously Wrong"
get "/" $ do
(r :: (Either TL.Text String)) <- liftIO $ runExceptT $ do
(uId) <- lift $ readFile "./helloworld.txt"
return $ ("hello")
liftIO $ print r
case r of
Left l -> raise l
Right s -> (html "hello world")
get "/catch-this" $ do
error "Catch Me"
(html "hello world")
notFound $ do
html "That is not a valid route"
I would like to be able to catch all of my uncaught exceptions in my default handler however this is not the default behavior of scotty that only happens if you call raise. I could wrap all of my ActionM code blocks in ExceptT however this seems like a messy/mechanical way of solving this problem. I mostly want to do this for logging purposes so I can report out to Sentry or Log to a file and this would make it much more convenient.
I figured I'd throw this in there as I recently was looking for this same solution again. It's unfortunate but I was never able to get the behavior that I wanted out of scotty.
Fortunately since scotty is just a nice library to create WAI application's you can get a nice work around using the Settings type from warp and the Options type from scotty.
Below is an example of how you can approach this:
{-# LANGUAGE OverloadedStrings #-}
module Lib
( someFunc
) where
import Web.Scotty.Trans
import Data.Text
import qualified Data.Text.Lazy as TL
import Control.Monad.IO.Class
import Control.Exception
import Network.HTTP.Types
import System.IO.Error
import Network.Wai.Handler.Warp
import Network.Wai
myOpts :: Options
myOpts = Options 1 mySettings
mySettings :: Settings
mySettings = setOnExceptionResponse myHandler $ setPort 3002 $ defaultSettings
myHandler :: SomeException -> Response
myHandler se = responseLBS status500 [] "HERE WE ARE"
someFunc :: IO ()
someFunc = do
scottyOptsT myOpts id routes
myExceptions :: (MonadIO m) => TL.Text -> ActionT TL.Text m ()
myExceptions t = do
liftIO $ print t
html "error"
routes :: (MonadIO m) => ScottyT TL.Text m ()
routes = do
defaultHandler $ \str -> do
liftAndCatchIO $ print str
status status500
json ("welp you thought"::Text)
get "/:here" $ do
liftIO $ ioError $ userError "Hahah"
text "here"
You can then tap further into the Settings type provided by warp so that you could maybe log all the error messages or perform some custom action using the following methods setOnException setOnExceptionResponse.

How to make MonadError work with ghcjs/reflex

I'm struggling to compile the following program:
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
import Reflex.Dom
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
-- let t = (T.pack "this program works if you replace the line below with this")
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
text t
however this similar version works with vanilla ghc
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
body
body = do
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
T.putStrLn t
The compiler says something is ambiguous and I'm not really sure how to implement these to work.
The type variable ‘e0’ is ambiguous
Relevant bindings include body :: m () (bound at reflex.hs:14:1)
These potential instances exist:
instance [safe] Control.Monad.Error.Class.MonadError e (Either e)
-- Defined in ‘Control.Monad.Error.Class’
...plus 13 instances involving out-of-scope types
instance [safe] Control.Monad.Error.Class.MonadError
GHC.IO.Exception.IOException IO
-- Defined in ‘Control.Monad.Error.Class’
instance [safe] (Monad m, Control.Monad.Trans.Error.Error e) =>
Control.Monad.Error.Class.MonadError
e (Control.Monad.Trans.Error.ErrorT e m)
-- Defined in ‘Control.Monad.Error.Class’
FYI: I haven't fully grasped Monads yet and easily get scared with these errors. Help!
In the ghc version, importString is operating in the context of an IO monad do statement . importString is capable of returning a value in the IO monad so the compiler is happy
In the ghcjs version, importString is operating in the context of an m monad do statement (m is specified in the declaration of body ). importString has no way to return a value in the m monad so the compiler complains.
You can get around this by using liftIO to change an IO monad value to a m monad value. Here's your code with this change and a few other changes that I made to help myself understand the code.
import Data.Maybe
import qualified Data.Text as T
import Data.URLEncoded as DU
import Reflex.Dom
import Control.Monad.Trans as CMT
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
let istr = CMT.liftIO $ DU.importString (T.unpack url)
t <- fmap (T.pack . fromMaybe "" . DU.lookup "parm2") istr
text t

Using ReaderT transformer in ScottyT (vs ActionT)

I'm trying to thread configuration through my Scotty based application using ReaderT monad transformer approach, and having trouble doing so. I have to use configuration both when defining routes (as some of them depend on the config) and when handling actual requests.
The latter works just fine in the ActionT, but no matter what I try I just can't get the types right in ScottyT.
Here's the minimal example I compiled from the ReaderT sample from Scotty GitHub repository:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks, lift, runReaderT)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Prelude
import Web.Scotty.Trans (ScottyT, get, scottyOptsT, text, capture)
data Config = Config
{ environment :: String
} deriving (Eq, Read, Show)
newtype ConfigM a = ConfigM
{ runConfigM :: ReaderT Config IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
application :: ScottyT Text ConfigM ()
application = do
get "/" $ do
e <- lift $ asks environment
text $ pack $ show e
path <- lift $ asks environment
get (capture path) $ do
text $ pack $ "Hello, custom path"
main :: IO ()
main = scottyOptsT def runIO application where
runIO :: ConfigM a -> IO a
runIO m = runReaderT (runConfigM m) config
config :: Config
config = Config
{ environment = "Development"
}
The error I'm getting is:
• No instance for (Control.Monad.Trans.Class.MonadTrans
(ScottyT Text))
arising from a use of ‘lift’
• In a stmt of a 'do' block: path <- lift $ asks environment
I've looked through the code where ScottyT type is outlined, and indeed there doesn't seem to be an instance of MonadTrans defined for it.
However, I don't feel I have enough both mana and Haskell experience to find a way out of it and would appreciate any help!
Thank you!
With a collective mind we all came to a currently viable solution to the problem.
ScottyT type cased to be a monad transformer with after https://github.com/scotty-web/scotty/pull/167 got merged, therefore there's currently no way of using it this way. There was a PR https://github.com/scotty-web/scotty/pull/181 aimed at bringing that feature back, but as far as I understood it has never got merged.
Since it's not a monad transformer we can only wrap it again:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks, lift, runReaderT)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Prelude
import Web.Scotty.Trans (ScottyT, get, scottyOptsT, text, capture)
data Config = Config
{ environment :: String
} deriving (Eq, Read, Show)
newtype ConfigM a = ConfigM
{ runConfigM :: ReaderT Config IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
application :: ConfigM (ScottyT Text ConfigM ())
application = do
path <- asks environment
return $
get "/" $ do
e <- lift $ asks environment
text $ pack $ show e
get (capture path) $
text $ pack $ "Hello, custom path"
runIO :: Config -> ConfigM a -> IO a
runIO c m = runReaderT (runConfigM m) c
main :: IO ()
main = do
let config = Config { environment = "/path" }
app <- runIO config application
scottyOptsT def (runIO config) app
Thanks everyone for helping me out, and hopefully this helps another wandering Scotty like me :).

How to combine postgresql snaplet and websockets?

The following code tries to combine two examples that work separately:
day 19 of 24 (2012) and e.g. ws example but I took almost everything websocket related away to get a small example.
Please, find the code below. The msgHandler is called by helloDb, which will get the the snaplet containing the db-connection and pass it to the msgHandler. The snaplet-posgresql-simple docs (at the end) give convenience instances and an example how to use one of them in the Initializer monad.
When I take the two commented lines away, ghc say that there are two instances involving out-of-scope types and that instances do overlapp: HasPostgres (ReaderT r m) and HasPostgres (ReaderT (Snaplet Postgres) m).
So the question is, how to get the program to compile so that I could pass db-connection from the snaplet to the websocket-part.
My goal is to make the websocket listen for messages, query db, and send messages pack. Other things that I already tried:
aFun :: (MonadIO m, HasPostgres m) => ... m (..) having both db-queries and websocket-things (both liftIO'd) compiles until WS.runWebSocketsSnap calls directly or indirectly aFun.
Tried to tell msgHandler :: (MonadIO m, HasPostgres m) but then ghc says that there is no instance for HasPosgres IO. My feeling is that this should be doable without IO-instance. Or is it?
The code below is trying to use snaplet in non-snaplet context but I'm not sure if this is the correct way.
Is there a better approach to combining websockets and (db-) snaplets in snapframework? After trying several approaches I'm in serious mental lock state obviously needing help. Any help (even small hints about what kind of things I should start learning/refreshing), will be highly appreciated!
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Maybe
import Data.Monoid ((<>))
import Control.Lens
import Control.Monad.Trans
import Control.Monad.Reader
import Snap.Snaplet
import Snap.Snaplet.PostgresqlSimple
import Snap.Http.Server
import Snap.Core as SC
import Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Snap as WS
newtype App = App { _db :: Snaplet Postgres }
makeLenses ''App
msgHandler :: (MonadIO m) => App -> BS.ByteString -> WS.PendingConnection -> m ()
msgHandler appSt mUId pending = do
conn <- liftIO $ WS.acceptRequest pending
-- res <- liftIO $ runReaderT (query "SELECT name FROM users WHERE id = ?" (Only mUId)) dbSnaplet
-- liftIO $ print (res :: [Name])
liftIO $ T.putStrLn "msgHandler ended"
where dbSnaplet = view db appSt
initApp :: SnapletInit App App
initApp = makeSnaplet "myapp" "My application" Nothing $
App <$> nestSnaplet "db" db pgsInit
<* addRoutes [("/hello/:id", helloDb)]
newtype Name = Name { _nm :: Text } deriving (Show, Eq)
instance FromRow Name where fromRow = Name <$> field
helloDb :: Handler App App ()
helloDb = do
Just mUId <- getParam "id"
userName <- with db $ listToMaybe <$> query "SELECT name FROM users WHERE id = ?" (Only mUId)
writeText $ maybe "User not found" (\h -> "Hello, " <> (T.pack . show) h) (userName :: Maybe Name)
sStApp <- getSnapletState
WS.runWebSocketsSnap $ msgHandler (view snapletValue sStApp) mUId
main :: IO ()
main = serveSnaplet defaultConfig initApp
The overlapping instance issue you ran into is a bug in the snaplet-postgresql-simple library that has been fixed but the fix has not yet been released. You might want to ask the maintainer about this.
In the meantime you can either pull the latest version of the library from Github, or redefine a type different but isomorphic to ReaderT (Snaplet Postgres), copying the HasPostgres instance.

lifting trouble with ResourceT

I'm adapting this example, in particular, the client. I'll tel you what I think the trouble is, following the code and the error it generates.
> {-# LANGUAGE OverloadedStrings #-}
> import Network.HTTP.Conduit
> ( http, parseUrl, newManager,def, withManager, RequestBody (RequestBodyLBS)
> , requestBody, method, Response (..)
> )
> import Data.Aeson (Value (Object, String))
> import Data.Aeson.Parser (json)
> import Data.Conduit
> import Data.Conduit.Attoparsec (sinkParser)
> import Control.Monad.IO.Class (liftIO)
> import Control.Monad.Trans.Class (lift)
> import Data.Aeson (encode, (.=), object)
> main :: IO ()
> main = withManager $ \manager -> do
> value <- makeValue
> -- We need to know the size of the request body, so we convert to a
> -- ByteString
> let valueBS = encode value
> req' <- parseUrl "http://10.64.16.6:3000/"
> let req = req' { method = "POST", requestBody = RequestBodyLBS valueBS }
> Response status version headers body <- http req manager
> resValue <- body $$ sinkParser json
> handleResponse resValue
> -- Application-specific function to make the request value
> makeValue :: ResourceT IO Value
> makeValue = return $ object
> [ ("foo" .= ("bar" :: String))
> ]
> -- Application-specific function to handle the response from the server
> handleResponse :: Value -> ResourceT IO ()
> handleResponse foo = do
> _ <- lift (print foo)
> return ()
No instance for (Control.Monad.Trans.Class.MonadTrans ResourceT)
arising from a use of `lift'
Possible fix:
add an instance declaration for
(Control.Monad.Trans.Class.MonadTrans ResourceT)
In a stmt of a 'do' block: _ <- lift (print foo)
In the expression:
do { _ <- lift (print foo);
return () }
In an equation for `handleResponse':
handleResponse foo
= do { _ <- lift (print foo);
return () }
Here's the problem, the error says there is no instance for Control.Monad.Trans.Class.MonadTrans ResourceT
But I think there is, due to this documentation. So where have things gone wrong?
As mentioned below there is something janke going on with Control.Monad.Trans.Resource
Here's the results of the ResourceT introspection.
*Main Control.Monad.Trans.Resource> :i ResourceT
newtype ResourceT m a
= Control.Monad.Trans.Resource.ResourceT (GHC.IORef.IORef
Control.Monad.Trans.Resource.ReleaseMap
-> m a)
-- Defined in `Control.Monad.Trans.Resource'
instance Monad m => Monad (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance Functor m => Functor (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance MonadBaseControl b m => MonadBaseControl b (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance MonadThrow m => MonadThrow (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
version of resourcet is
[mlitchard#Boris Boris]$ ghc-pkg list resourcet
WARNING: there are broken packages. Run 'ghc-pkg check' for more details.
/usr/lib/ghc-7.4.1/package.conf.d
/home/mlitchard/.ghc/x86_64-linux-7.4.1/package.conf.d
resourcet-0.3.2.1
Any ideas on how to proceed?
Where's the instance for MonadTrans ResourceT?
If I were a betting man, I would say you have multiple versions of some library installed. For example, say you have version 0.2 and 0.3 of transformers, and resourcet is built against version 0.2. When you write the code import Control.Monad.Trans.Class (lift) you're importing version 0.3 of lift, but there are no instances for it involved.
Easiest way to test this is to cabalize your code. Cabal will make sure you have the right versions of the libraries involved.
EDIT: This answer does not solve the problem, the import does still not resolve the instances, even though it should. This seems to be a bug in either GHC or some other system.
The Data.Conduit module only re-exports ResourceT as a convenience; the resource monad transformer is defined in a separate package resourcet. conduit does for that reason not re-export class instances (apparently?). You need to manually import Control.Monad.Trans.Resource to gain access to the associated class instances. This can of course be done with the following syntax:
import Control.Monad.Trans.Resource () -- Only import instances

Resources