purescript-postgresql-client library monad

PG.js

exports.getSQLState = function (error) {
  return error.code || ''
}

exports.getError = function (errorType) {
  return function (error) {
    return {
      errorType: errorType,
      severity: error.severity || '',
      code: error.code || '',
      message: error.message || '',
      detail: error.detail || '',
      hint: error.hint || '',
      position: error.position || '',
      internalPosition: error.internalPosition || '',
      internalQuery: error.internalQuery || '',
      where_: error.where || '',
      schema: error.schema || '',
      table: error.table || '',
      column: error.column || '',
      dataType: error.dataType || '',
      constraint: error.constraint || '',
      file: error.file || '',
      line: error.line || '',
      routine: error.routine || ''
    }
  }
}

PG.purs

module PoC.PG
  ( PGError
  , PGErrorType
  , DB
  , withConnection
  , query
  , command
  , scalar
  , onIntegrityError
  , module Database.PostgreSQL
  ) where

import Prelude

import Control.Monad.Error.Class (try)
import Control.Monad.Except (ExceptT)
import Control.Monad.Except as Except
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (lmap)
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Maybe as Maybe
import Data.String (Pattern(..))
import Data.String as String
import Database.PostgreSQL (class ToSQLRow, class FromSQLRow, class FromSQLValue, Connection, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row4(Row4), Row5(Row5), Row6(Row6), Row7(Row7), Row8(Row8), Row9(Row9), Row10(Row10), Row11(Row11), Row12(Row12), Row13(Row13), Row14(Row14), Row15(Row15), Row16(Row16), Row17(Row17), Row18(Row18), Row19(Row19), Pool, PoolConfiguration, newPool)
import Database.PostgreSQL as PG
import Effect.Aff (Aff)
import Effect.Exception as Exception


data PGErrorType
  = DatabaseError
  | InternalError
  | OperationalError
  | ProgrammingError
  | IntegrityError
  | DataError
  | NotSupportedError
  | QueryCanceledError
  | TransactionRollbackError


derive instance genericPGErrorType :: Generic PGErrorType _

instance showPGErrorType :: Show PGErrorType where
  show = genericShow


type PGError =
  { errorType :: PGErrorType
  , severity :: String
  , code :: String
  , message :: String
  , detail :: String
  , hint :: String
  , position :: String
  , internalPosition :: String
  , internalQuery :: String
  , where_ :: String
  , schema :: String
  , table :: String
  , column :: String
  , dataType :: String
  , constraint :: String
  , file :: String
  , line :: String
  , routine :: String
  }

type DB a = ExceptT PGError Aff a

foreign import getSQLState :: Exception.Error -> String
foreign import getError :: PGErrorType -> Exception.Error -> PGError

convertError :: Exception.Error -> PGError
convertError err =
  getError errorType err

  where
    errorType =
      if error "0A" then NotSupportedError
      else if error "20" || error "21" then ProgrammingError
      else if error "22" then DataError
      else if error "23" then IntegrityError
      else if error "24" || error "25" then InternalError
      else if error "26" || error "27" || error "28" then OperationalError
      else if error "2B" || error "2D" || error "2F" then InternalError
      else if error "34" then OperationalError
      else if error "38" || error "39" || error "3B" then InternalError
      else if error "3D" || error "3F" then ProgrammingError
      else if error "40" then TransactionRollbackError
      else if error "42" || error "44" then ProgrammingError
      else if sqlState == "57014" then QueryCanceledError
      else if error "5" then OperationalError
      else if error "F" then InternalError
      else if error "H" then OperationalError
      else if error "P" then InternalError
      else if error "X" then InternalError
      else DatabaseError

    error prefix =
      Maybe.maybe false (_ == 0) $ String.indexOf (Pattern prefix) sqlState

    sqlState =
      getSQLState err


toDB :: forall a. Aff a -> DB a
toDB aff = do
  result <- lift $ try aff
  Except.except $ lmap convertError result


eitherToDB :: forall a. Aff (Either PGError a) -> DB a
eitherToDB aff = do
  result <- lift $ try aff
  Except.except $ join $ lmap convertError result


withConnection
  :: ∀ a
   . Pool
  -> (Connection -> DB a)
  -> DB a
withConnection p k = do
  eitherToDB $ PG.withConnection p (Except.runExceptT <<< k)


query
  :: ∀ i o
   . ToSQLRow i
  => FromSQLRow o
  => Connection
  -> Query i o
  -> i
  -> DB (Array o)
query c q i =
  toDB $ PG.query c q i


command
  :: ∀ i
   . ToSQLRow i
  => Connection
  -> Query i Int
  -> i
  -> DB Int
command c q i =
  toDB $ PG.command c q i


scalar
  :: ∀ i o
   . ToSQLRow i
  => FromSQLValue o
  => Connection
  -> Query i (Row1 o)
  -> i
  -> DB (Maybe o)
scalar c q i =
  toDB $ PG.scalar c q i


isIntegrityError :: PGError -> Maybe Unit
isIntegrityError { errorType } =
  case errorType of
    IntegrityError -> Just unit
    _ -> Nothing


onIntegrityError :: forall a. DB a -> DB a -> DB a
onIntegrityError errorResult db =
  Except.catchJust isIntegrityError db (const errorResult)

Hi @akheron,

At first I want to thank you because you have not only investigated the issue down to the js error structure level but you also brought this to our API level and wrapped it into nice monad stack.
It seems that I'm not able to comment on commit directly so I'm going to add here a few words (with some repetition from our chat included). These are merely propositions which I want to discuss with you further.
It is also quite possible that I'm talking a lot of bullshit here as it is quite late now ;-)

1. I understand that current design is built on top of existing FFI but I'm not sure if we want to be backward compatible and preserve and expose this kind of FFI functions without error handling baked in. I think that below comments follow from this issue.

• Let's consider that we are moving error handling to FFI by providing additional record of nearly Either constructors. Something like this:

  foreign import ffiUnsafeQuery
    :: { nullableLeft :: Exception.Error -> Nullable (Either e a)
       , right :: a -> Either e a
       }
    -> Connection
    -> String
    -> Array Foreign
    -> EffectFnAff (Either e (Array (Array Foreign)))

• Then convertError can be really exhaustive: convertError :: Exception.Error -> Maybe PGError which can be easily turned into Nullable version with toNullable.

• toDb would become just liftAff because we can be sure that there is no way to construct Aff a which carries Exception.Error related to database. ExceptT has already MonadAff instance

2. The other question is related to the structure of PgError which we discussed already. It would be more natural to drop errorType from error record and move this record "under" every PgError constructor like:

   data PgErrorType
     = DatabaseError PgError
     | InternalError PgError
     ...

   Then we can distinguish error types just by pattern matching on constructor. Of course we can rename PgErrorType and PgError accordingly to the changes.
   I'm not sure if we gain anything here by this move at the moment, but if we discover that there are any differences in the structure between error records this type structure can be really useful.
3. It is rather a joke and I'm rather sure that it is not worth time and effort but I think it is possible to define something generic like:
   catchCase (SProxy :: Sproxy "ConstructorName") db onErr.