Scotty / Haskell Exception Exception

Question

I am just starting to learn Haskell and focus on how to handle exceptions in Scotty.

I have the main function below. It receives a JSON POST, converts it to a Haskell data record, grabs the postgres connection pool from the configuration reader, and then inserts the record into 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 fine, but when I change UniqueViolation to return text, it does not compile.

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

Indicated compilation error:

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 Database.PostgreSQL.Simple.Errors and has the following link:

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

I know that part of the problem is getting IO Int64 from PgSQL.execute, but ActionT is from a trap, but not sure how to resolve types or a more idiomatic way to do this.

Answer 1

, catchViolation IO, text ActionT e IO, , IO, ActionT monad transformer.

. ActionT , "response-in-construction" ( text ).

text catchViolation. catchViolation Either, , ActionT, Either, , . - :

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"

, , . , ActionT MonadBaseControl. , " ", , . , catchViolation, "" .

( , - , spring.)

- :

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

control. control (RunInBase m b), " ". IO ActionT. catchViolation, control , , ActionT.

Answer 2

, Either. Control.Exception, IO :

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

try, [ SqlError Int64] PostgreSQL, PostgreSQL Simple constraintViolation Control.Arrow.left, fooobar.com/questions/349397/....

constraintViolation :: SqlError -> Maybe ConstraintViolation

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

Either (Maybe ConstraintViolation) Int64

, , , ?

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

ViewPatterns .

{-# 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