From ec1f6e447de38114e198cc278411c8ed7e8a8d13 Mon Sep 17 00:00:00 2001 From: Kamirus Date: Wed, 28 Aug 2019 17:00:36 +0200 Subject: [PATCH] drop PG type and change functions in PG module; some test changes; no README fix --- README.md | 2 +- src/Database/PostgreSQL/PG.purs | 111 ++++++++++++++++---------------- test/Main.purs | 14 +++- 3 files changed, 67 insertions(+), 60 deletions(-) diff --git a/README.md b/README.md index acc8fb9..ebfb3ae 100644 --- a/README.md +++ b/README.md @@ -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(..)) diff --git a/src/Database/PostgreSQL/PG.purs b/src/Database/PostgreSQL/PG.purs index 01af3da..06a9cd0 100644 --- a/src/Database/PostgreSQL/PG.purs +++ b/src/Database/PostgreSQL/PG.purs @@ -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 - - diff --git a/test/Main.purs b/test/Main.purs index 46c1d3f..1ecb4c1 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -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