drop PG type and change functions in PG module; some test changes; no README fix

This commit is contained in:
Kamirus 2019-08-28 17:00:36 +02:00
parent 86a431c744
commit ec1f6e447d
3 changed files with 67 additions and 60 deletions

View File

@ -18,7 +18,7 @@ module Test.README where
import Prelude
import Database.PostgreSQL.PG (defaultPoolConfiguration, command, execute, newPool, PG, query, Query(Query), withConnection, withTransaction)
import Database.PostgreSQL.PG (defaultPoolConfiguration, command, execute, newPool, query, Query(Query), withConnection, withTransaction)
import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3))
import Data.Decimal as Decimal
import Data.Maybe (Maybe(..))

View File

@ -2,11 +2,8 @@ module Database.PostgreSQL.PG
( module Row
, module Value
, module PostgreSQL
, PG
, command
, execute
, hoist
, hoistWith
, query
, onIntegrityError
, scalar
@ -17,10 +14,8 @@ module Database.PostgreSQL.PG
import Prelude
import Control.Monad.Error.Class (class MonadError, catchError, throwError)
import Control.Monad.Except (ExceptT(..))
import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Data.Maybe (Maybe, maybe)
import Database.PostgreSQL (Connection, PGError(..), Pool, Query)
import Database.PostgreSQL (class FromSQLRow, class FromSQLValue, class ToSQLRow, class ToSQLValue, Connection, Database, PGError(..), PGErrorDetail, Pool, PoolConfiguration, Query(..), Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), defaultPoolConfiguration, fromSQLRow, fromSQLValue, instantFromString, instantToString, newPool, null, toSQLRow, toSQLValue, unsafeIsBuffer) as PostgreSQL
import Database.PostgreSQL (command, execute, query, scalar, withConnection, withTransaction) as P
@ -33,35 +28,24 @@ import Effect.Aff.Class (class MonadAff, liftAff)
type Database = String
-- | PostgreSQL computations run in the `PG` monad. It's just `Aff` stacked with
-- | `ExceptT` to provide error handling.
-- |
-- | Errors originating from database queries or connection to the database are
-- | modeled with the `PGError` type. Use `runExceptT` from
-- | `Control.Monad.Except.Trans` to turn a `PG a` action into `Aff (Either
-- | PGError a)`.
type PG a = ExceptT PGError Aff a
hoistWith :: forall e m. MonadAff m => MonadError e m => (PGError -> e) -> PG ~> m
hoistWith f m = do
result <- liftAff $ runExceptT m
case result of
Right a -> pure a
Left pgError -> throwError (f pgError)
hoist :: forall m. MonadAff m => MonadError PGError m => PG ~> m
hoist = hoistWith identity
hoistAffEither :: forall a m. MonadAff m => MonadError PGError m => Aff (Either PGError a) -> m a
hoistAffEither m = liftAff m >>= either throwError pure
-- | Run an action with a connection. The connection is released to the pool
-- | when the action returns.
withConnection
:: forall a
. Pool
-> (Connection -> PG a)
-> PG a
withConnection p k = ExceptT $ P.withConnection p case _ of
Right conn -> runExceptT $ k conn
Left pgErr -> pure (Left pgErr)
:: forall a m
. MonadError PGError m
=> MonadAff m
=> Pool
-> (m a -> Aff (Either PGError a))
-> (Connection -> m a)
-> m a
withConnection p f k = do
res <- liftAff $ P.withConnection p case _ of
Right conn -> f $ k conn
Left pgErr -> pure $ Left pgErr
either throwError pure res
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
@ -69,61 +53,78 @@ withConnection p k = ExceptT $ P.withConnection p case _ of
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction.
withTransaction
:: forall a
. Connection
-> PG a
-> PG a
withTransaction conn action =
ExceptT $ join <$> P.withTransaction conn (runExceptT action)
:: forall a m
. MonadAff m
=> MonadError PGError m
=> Connection
-> (m a -> Aff (Either PGError a))
-> m a
-> m a
withTransaction conn f action = do
res <- liftAff $ P.withTransaction conn (f action)
either throwError pure $ join res
-- | Execute a PostgreSQL query and discard its results.
execute
:: forall i o
. (ToSQLRow i)
:: forall i o m
. ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i o
-> i
-> PG Unit
execute conn sql values = ExceptT $ P.execute conn sql values >>= case _ of
Just pgErr -> pure (Left pgErr)
Nothing -> pure (Right unit)
-> m Unit
execute conn sql values = do
err <- liftAff $ P.execute conn sql values
maybe (pure unit) throwError err
-- | Execute a PostgreSQL query and return its results.
query
:: forall i o
:: forall i o m
. ToSQLRow i
=> FromSQLRow o
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i o
-> i
-> PG (Array o)
query conn sql = ExceptT <<< P.query conn sql
-> m (Array o)
query conn sql = hoistAffEither <<< P.query conn sql
-- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result.
scalar
:: forall i o
:: forall i o m
. ToSQLRow i
=> FromSQLValue o
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i (Row1 o)
-> i
-> PG (Maybe o)
scalar conn sql = ExceptT <<< P.scalar conn sql
-> m (Maybe o)
scalar conn sql = hoistAffEither <<< P.scalar conn sql
-- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries.
command
:: forall i
:: forall i m
. ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection
-> Query i Int
-> i
-> PG Int
command conn sql = ExceptT <<< P.command conn sql
-> m Int
command conn sql = hoistAffEither <<< P.command conn sql
onIntegrityError :: forall a. PG a -> PG a -> PG a
onIntegrityError
:: forall a m
. MonadError PGError m
=> m a
-> m a
-> m a
onIntegrityError errorResult db =
catchError db handleError
where
@ -131,5 +132,3 @@ onIntegrityError errorResult db =
case e of
IntegrityError _ -> errorResult
_ -> throwError e

View File

@ -5,7 +5,7 @@ module Test.Main
import Prelude
import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Control.Monad.Trans.Class (lift)
import Data.Array (zip)
import Data.Date (Date, canonicalDate)
@ -20,7 +20,8 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Database.PostgreSQL.PG (Connection, PG, PGError(..), PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, onIntegrityError, query, scalar, withConnection, withTransaction)
import Database.PostgreSQL.PG (Connection, PGError(..), Pool, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, onIntegrityError, query, scalar)
import Database.PostgreSQL.PG as PG
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff)
import Effect.Class (liftEffect)
@ -30,12 +31,19 @@ import Global.Unsafe (unsafeStringify)
import Math ((%))
import Partial.Unsafe (unsafePartial)
import Test.Assert (assert)
import Test.README (run) as README
import Test.Unit (TestSuite, suite)
import Test.Unit as Test.Unit
import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest)
type PG a = ExceptT PGError Aff a
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
withConnection conn = PG.withConnection conn runExceptT
withTransaction :: forall a. Connection -> PG a -> PG a
withTransaction conn = PG.withTransaction conn runExceptT
pgEqual :: forall a. Eq a => Show a => a -> a -> PG Unit
pgEqual a b = lift $ equal a b