Snap: catch snaplet-postgresql-simple exception in handler

Question

I'm struggling to catch postgressq errors in my handlers. A simplified example is below.

import qualified Control.Monad.CatchIO as CI (try,MonadCatchIO)
import qualified Snap.Snaplet.PostgresqlSimple as D

logConfirmMessages' :: ConfirmLog -> Handler App (AuthManager App) ()
logConfirmMessages' ms = do
  let (s,i,d) = ms
  let log =  T.unpack s ++ "," ++ T.unpack i ++ "," ++ show d ++ ","

  result <- liftIO $ 
              CI.try $ 
                (D.execute "update cr_trades set status=? where email=? and trade_dt=?" ms) 
                  :: Handler App (AuthManager App)  (Either D.SqlError Int64)

  case result of
    Left e -> logTNmsg $ log ++ show e
    Right r -> logTNmsg $ log ++ show r

The error I'm getting is:

    * No instance for (D.HasPostgres IO)
        arising from a use of `D.execute'
    * In the second argument of `($)', namely
        `(D.execute
            "update cr_trades set status=? where email=? and trade_dt=?" ms)'
      In the second argument of `($)', namely
        `CI.try
           $ (D.execute
                "update cr_trades set status=? where email=? and trade_dt=?" ms)'
      In a stmt of a 'do' block:
        result <- liftIO
                    $ CI.try
                        $ (D.execute
                             "update cr_trades set status=? where email=? and trade_dt=?" ms) ::
                    Handler App (AuthManager App) (Either D.SqlError Int64)

Any pointers? Thanks in advance.

Answer 1

Use liftPG' to get a postgres connection, and postgresql-simple primitives for the execute:

import qualified Data.PostgreSQL.Simple as PG

D.liftPG' $ \conn -> CI.try @PG.SqlError $ PG.execute conn "update blah blah" ms

(PG.SqlError and D.SqlError are the same entity, just different names.)

You can probably cook up a suitable exception-y monad with a HasPostgres instance that makes this pattern more convenient.