Catching exceptions in Scotty / Haskell

4
votes

I'm just starting out learning Haskell and am stuck on how to handle exceptions in Scotty.

I have the basic function below. It gets a JSON POST, converts it in to a Haskell data record, gets a hold of a postgres connection pool from the config reader and then inserts the record in to the database.

create :: ActionT Text ConfigM ()
create = do
    a :: Affiliate <- jsonData
    pool  <- lift $ asks pool
    _ <- liftIO $ catchViolation catcher $ withResource pool $ \conn ->
        PgSQL.execute conn "INSERT INTO affiliate (id, network, name, status) VALUES (?, ?, ?, ?)"
            (slug a, network a, name a, status a)
    let s = fromStrict $ unSlug $ slug a
    text $ "Created: " `T.append` s
where
    catcher e (UniqueViolation "mykey") = throw e --text "Error"
    catcher e _ = throw e

This function compiles ok but when I change the UniqueViolation to return text it fails to compile.

catcher e (UniqueViolation "mykey") = text "Error"

The compilation error given is:

Couldn't match type ‘ActionT e0 m0 ()’ with ‘IO Int64’
    Expected type: PgSQL.SqlError -> ConstraintViolation -> IO Int64
      Actual type: PgSQL.SqlError
               -> ConstraintViolation -> ActionT e0 m0 ()
In the first argument of ‘catchViolation’, namely ‘catcher’
In the expression: catchViolation catcher

catchViolation comes from the Database.PostgreSQL.Simple.Errors and has the below signiture:

catchViolation :: (SqlError -> ConstraintViolation -> IO a) -> IO a -> IO a

I know part of the issue is it's getting the IO Int64 from PgSQL.execute but a ActionT from the catcher but not sure how to resolve the types or a more idiomatic way of doing this.

2
haskellscotty

2 Answers

4
votes

The problem is that the return value of catchViolation lives in the IO monad, but text lives in the ActionT e IO monad, which is a monad built on top on IO using the ActionT monad transformer.

Monad transformers add additional capabilities to their base monads. In the case of ActionT, it adds things like access to the "response-in-construction" (which is why text requires it).

One possible solution is to pull the use of text out of catchViolation. Instead, make catchViolation return an Either, and then, once back into an ActionT context, pattern match on the Either to decide what to do. Something like:

ei <- liftIO $ catchViolation catcher $ fmap Right $ withResource pool
case ei of
    Left str -> text str
    Right _ -> return ()
where 
    catcher e (UniqueViolation "mykey") = return $ Left "some error"
    catcher e _ = return $ Left "some other error"

There's another solution, more powerful but not as intuitive. It happens that ActionT is an instance of MonadBaseControl. This typeclass has methods that let you hide all the "extra layers" added by monad transformers into a plain value of the base monad. You can then pass that value to some callback-accepting function like catchViolation, and afterwards "pop out" all the extra layers back.

(It's a bit like pressing a jack-in-the-box back into its box in order to pass through customs or whatever, and then making it spring out again.)

It would be something like:

control $ \runInBase -> catchViolation 
     (\_ _ -> runInBase $ text "some error") 
     (runInBase $ liftIO $ withResource $ 
                .... all the query stuff goes here ...)

We are using the control utility function. control provides you with a magical function (RunInBase m b) that lets you "put the jack-in-the-box back into the box". That is, construct an IO value out of an ActionT one. You then pass that value to catchViolation, and control takes care of unpaking the layers encoded in the result, bringing back the full ActionT monad at the end.

0
votes

Thanks you put me on the right lines with the Either. I found try in Control.Exception which creates an Either from an IO of a:

try :: Exception e => IO a -> IO (Either e a)

I use try to give me an [Either SqlError Int64] from the PostgreSQL Simple execute function then do a map on the left values with the PostgreSQL Simple constraintViolation function using Control.Arrow.left which I found at https://stackoverflow.com/a/13504032/2658199.

constraintViolation :: SqlError -> Maybe ConstraintViolation

left :: a b c -> a (Either b d) (Either c d)

This then gives me the below type to pattern match on

Either (Maybe ConstraintViolation) Int64

With the above I've come up with the this which I'm happy with but not sure if idiomatic or can be further improved?

create' :: ActionT Text ConfigM ()
create' = do
  a :: Affiliate <- jsonData
  pool  <- lift $ asks pool
  result <- liftIO $ E.try $ withResource pool $ \conn -> do
       PgSQL.execute conn "INSERT INTO affiliate (id, network, name, status) VALUES (?, ?, ?, ?)"
                (slug a, network a, name a, status a)
  let slugT = fromStrict $ unSlug $ slug a
  case left constraintViolation result of
    Right _ -> text $ "Created: " `T.append` slugT
    Left(Just(UniqueViolation "mykey")) -> text "Duplicate key"
    _ -> text "Fatal Error"

Update

After the suggestion of using ViewPatterns I've simplified my previous version to the below.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-}

create :: ActionT Text ConfigM ()
create = do
    a :: A.Affiliate <- jsonData
    pool  <- lift $ asks pool
    result <- liftIO $ try $ withResource pool $ \conn ->
        PgSQL.execute conn "INSERT INTO affiliate (id, network, name, status) VALUES (?, ?, ?, ?)"
          (A.slug a, A.network a, A.name a, A.status a)
    let slugT = fromStrict $ unSlug $ A.slug a
    case result of
        Right _ -> text ("Created: " `T.append` slugT) >> status created201
        Left (constraintViolation -> Just (UniqueViolation _)) -> text (slugT `T.append` " already exists") >> status badRequest400
        Left e -> throw e