I started using Yesod to develop a little project, this is the first time I use Haskell to do something real. This code that handles a registration form works fine:
postRegisterR :: Handler ()
postRegisterR = do email <- runInputPost $ ireq textField "email"
user <- runInputPost $ ireq textField "user"
pwd <- runInputPost $ ireq textField "pwd"
cpwd <- runInputPost $ ireq textField "cpwd"
if pwd == cpwd && isValidEmail email
then do
tryInsert email user pwd
setSession "user" user
redirectUltDest SessionR
else do
redirect HomeR
tryInsert :: Text -> Text -> Text -> Handler ()
tryInsert email user pwd = do pwdbs <- liftIO $ hashedPwd pwd
_ <- runDB $ insert $ User email user pwdbs
return ()
Now the problem is: if I sign in twice with the same credentials I get an InternalServerError
. This is right, because in my model configuration there is UniqueUser email username
. So I'd like to catch and handle this error in some way. How can I do that and, in general, how exception handling works in Haskell when you are dealing with non-IO monads defined in an external library or framework?
PS: I read this tutorial, but that is useful if you are designing a new library. I tryed to use the catch function, but I got a lot of type errors.
Edit
Thank you Ankur, your code worked with a little modification, to remove this error:
Ambiguous type variable `e0' in the constraint:
(Exception e0) arising from a use of `catch'
Probable fix: add a type signature that fixes these type variable(s)
code:
tryInsert :: Text -> Text -> ByteString -> Handler Bool
tryInsert email user pwd = HandlerT (\d -> catch (unHandlerT (runDB $ insert $ User email user pwd) d
>> return True)
(\(e :: SomeException) -> return False))
With ScopedTypeVariables
extension enabled
Edit 2
Final version, after bennofs' hint:
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception.Lifted (catch)
import Control.Monad (void)
postRegisterR :: Handler ()
postRegisterR = do email <- runInputPost $ ireq textField "email"
user <- runInputPost $ ireq textField "user"
pwd <- runInputPost $ ireq textField "pwd"
cpwd <- runInputPost $ ireq textField "cpwd"
if pwd == cpwd && isValidEmail email
then do
pwdbs <- liftIO $ hashedPwd pwd
success <- tryInsert email user pwdbs
case success of
True -> do setSession "user" user
redirectUltDest SessionR
False -> redirect HomeR
else do
redirect HomeR
tryInsert :: Text -> Text -> ByteString -> Handler Bool
tryInsert email user pwd = do void $ runDB $ insert $ User email user pwd
return True
`catch` (\(e :: SomeException) ->
do return False)
There is a package called lifted-base, which also provides a more generic catch function:
Control.Exception.Lifted.catch ::
(MonadBaseControl IO m, Exception e)
=> m a -- ^ The computation to run
-> (e -> m a) -- ^ Handler to invoke if an exception is raised
-> m a
There exists an instance MonadBaseControl IO Handler, so you can just use this function:
{-# LANGUAGE ScopedTypeVariables #-} -- I think this is needed PatternSignatures.
import Control.Exception.Lifted (catch)
import Control.Monad (void)
tryInsert :: Text -> Text -> Text -> Handler ()
tryInsert email user pwd = do
pwdbs <- liftIO $ hashedPwd pwd
(void $ runDB $ insert $ User email user pwdbs) `catch` \(e :: SomeException) -> do
-- Your exception handling goes code here. This code also lives in the Handler monad.
return ()
return ()
Another possibility is to use MonadCatchIO-mtl, which also provides a generic catch function. MonadCatchIO-mtl won't build on GHC HEAD though. I also still think that using insertUnique
is the cleanest way to handle this.
You can try something like shown below, basically Handler
is HandlerT
which is monad transformer (I haven't type checked the code below :))
tryInsert :: Text -> Text -> Text -> Handler Bool
tryInsert email user pwd = HandlerT (\d -> do pwdbs <- hashedPwd pwd
catch (unHandlerT (runDB $ insert $ User email user pwdbs) d >> return True)
(\e -> return False))
And check the returned bool value if there was exception or not.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With