diff --git a/src/Database/PostgreSQL/Aff.js b/src/Database/PostgreSQL/Aff.js index 431ea0a..52db2ee 100644 --- a/src/Database/PostgreSQL/Aff.js +++ b/src/Database/PostgreSQL/Aff.js @@ -79,6 +79,7 @@ exports.ffiSQLState = function (error) { exports.ffiErrorDetail = function (error) { return { + error: error, severity: error.severity || '', code: error.code || '', message: error.message || '', diff --git a/src/Database/PostgreSQL/Aff.purs b/src/Database/PostgreSQL/Aff.purs index 9576ea7..cbda9e7 100644 --- a/src/Database/PostgreSQL/Aff.purs +++ b/src/Database/PostgreSQL/Aff.purs @@ -32,6 +32,7 @@ import Data.Nullable (Nullable, toMaybe, toNullable) import Data.Profunctor (lcmap) import Data.String (Pattern(..)) import Data.String as String +import Data.Symbol (SProxy(..)) import Data.Traversable (traverse) import Database.PostgreSQL.Pool (Pool) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), fromSQLRow, toSQLRow) @@ -42,6 +43,7 @@ import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff) import Effect.Class (liftEffect) import Effect.Exception (Error) import Foreign (Foreign) +import Record (delete) as Record import Unsafe.Coerce (unsafeCoerce) -- | PostgreSQL connection. @@ -113,7 +115,7 @@ withTransaction pool action = Right client -> withClientTransaction client do (action $ fromClient client) - Left err → pure $ Left err + Left err -> pure $ Left err -- | TODO: Outdated docs -- | Run an action within a transaction. The transaction is committed if the @@ -161,7 +163,7 @@ fromClient client = Connection (Right client) -- | APIs of the `Pool.query` and `Client.query` are the same. -- | We can dse this polyformphis to simplify ffi. -foreign import data UntaggedConnection ∷ Type +foreign import data UntaggedConnection :: Type -- | Execute a PostgreSQL query and discard its results. execute :: @@ -222,7 +224,7 @@ unsafeQuery :: Aff (Either PGError QueryResult) unsafeQuery conn s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler conn) s where - toUntaggedHandler ∷ Connection → UntaggedConnection + toUntaggedHandler :: Connection -> UntaggedConnection toUntaggedHandler (Connection c) = case c of (Left pool) -> unsafeCoerce pool (Right client) -> unsafeCoerce client @@ -242,7 +244,7 @@ foreign import ffiUnsafeQuery :: EffectFnAff (Either PGError QueryResult) data PGError - = ClientError String + = ClientError Error String | ConversionError String | InternalError PGErrorDetail | OperationalError PGErrorDetail @@ -253,7 +255,26 @@ data PGError | QueryCanceledError PGErrorDetail | TransactionRollbackError PGErrorDetail -derive instance eqPGError :: Eq PGError +-- | Those instances are required for testing. +instance eqPGError :: Eq PGError where + eq = case _, _ of + (ClientError _ s1), (ClientError _ s2) -> s1 == s2 + (ConversionError s1), (ConversionError s2) -> s1 == s2 + (InternalError err1), (InternalError err2) -> eqErr err1 err2 + (OperationalError err1), (OperationalError err2) -> eqErr err1 err2 + (ProgrammingError err1), (ProgrammingError err2) -> eqErr err1 err2 + (IntegrityError err1), (IntegrityError err2) -> eqErr err1 err2 + (DataError err1), (DataError err2) -> eqErr err1 err2 + (NotSupportedError err1), (NotSupportedError err2) -> eqErr err1 err2 + (QueryCanceledError err1), (QueryCanceledError err2) -> eqErr err1 err2 + (TransactionRollbackError err1), (TransactionRollbackError err2) -> eqErr err1 err2 + _, _ -> false + where + eqErr err1 err2 = + let + _error = SProxy :: SProxy "error" + in + eq (Record.delete _error err1) (Record.delete _error err2) derive instance genericPGError :: Generic PGError _ @@ -265,6 +286,7 @@ type PGErrorDetail , code :: String , message :: String , detail :: String + , error :: Error , hint :: String , position :: String , internalPosition :: String @@ -345,7 +367,7 @@ convertError err = case toMaybe $ ffiSQLState err of if prefix "X" s then InternalError else - const $ ClientError s + const $ ClientError err s prefix :: String -> String -> Boolean prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p) diff --git a/test/Main.purs b/test/Main.purs index 9d4fa4e..f807ad3 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,7 +3,6 @@ module Test.Main ) where import Prelude - import Control.Monad.Error.Class (throwError, try) import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Trans.Class (lift) @@ -59,6 +58,7 @@ withRollback ∷ withRollback client action = begin *> action *> rollback where conn = fromClient client + begin = execute conn (Query "BEGIN TRANSACTION") Row0 rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0 @@ -69,6 +69,7 @@ test ∷ AppM Unit → TestSuite test (Connection (Left pool)) name action = Test.Unit.test name $ checkPGErrors $ action + test (Connection (Right client)) name action = Test.Unit.test name $ checkPGErrors $ withRollback client action transactionTest ∷ @@ -471,7 +472,7 @@ main = do testPool <- liftEffect $ Pool.new (cannotConnectConfig config) runExceptT (withClient testPool doNothing) >>= case _ of - Left (ClientError cause) -> equal cause "ECONNREFUSED" + Left (ClientError _ cause) -> equal cause "ECONNREFUSED" _ -> Test.Unit.failure "foo" Test.Unit.test "no such database" do testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config)