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 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 Database.PostgreSQL.Row (Row0(Row0), Row3(Row3))
import Data.Decimal as Decimal import Data.Decimal as Decimal
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))

View File

@ -2,11 +2,8 @@ module Database.PostgreSQL.PG
( module Row ( module Row
, module Value , module Value
, module PostgreSQL , module PostgreSQL
, PG
, command , command
, execute , execute
, hoist
, hoistWith
, query , query
, onIntegrityError , onIntegrityError
, scalar , scalar
@ -17,10 +14,8 @@ module Database.PostgreSQL.PG
import Prelude import Prelude
import Control.Monad.Error.Class (class MonadError, catchError, throwError) import Control.Monad.Error.Class (class MonadError, catchError, throwError)
import Control.Monad.Except (ExceptT(..)) import Data.Either (Either(..), either)
import Control.Monad.Except.Trans (ExceptT, runExceptT) import Data.Maybe (Maybe, maybe)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Database.PostgreSQL (Connection, PGError(..), Pool, Query) 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 (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 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 type Database = String
-- | PostgreSQL computations run in the `PG` monad. It's just `Aff` stacked with hoistAffEither :: forall a m. MonadAff m => MonadError PGError m => Aff (Either PGError a) -> m a
-- | `ExceptT` to provide error handling. hoistAffEither m = liftAff m >>= either throwError pure
-- |
-- | 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
-- | Run an action with a connection. The connection is released to the pool -- | Run an action with a connection. The connection is released to the pool
-- | when the action returns. -- | when the action returns.
withConnection withConnection
:: forall a :: forall a m
. Pool . MonadError PGError m
-> (Connection -> PG a) => MonadAff m
-> PG a => Pool
withConnection p k = ExceptT $ P.withConnection p case _ of -> (m a -> Aff (Either PGError a))
Right conn -> runExceptT $ k conn -> (Connection -> m a)
Left pgErr -> pure (Left pgErr) -> 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 -- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a -- | 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 -- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction. -- | within the transaction.
withTransaction withTransaction
:: forall a :: forall a m
. Connection . MonadAff m
-> PG a => MonadError PGError m
-> PG a => Connection
withTransaction conn action = -> (m a -> Aff (Either PGError a))
ExceptT $ join <$> P.withTransaction conn (runExceptT action) -> 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 a PostgreSQL query and discard its results.
execute execute
:: forall i o :: forall i o m
. (ToSQLRow i) . ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection => Connection
-> Query i o -> Query i o
-> i -> i
-> PG Unit -> m Unit
execute conn sql values = ExceptT $ P.execute conn sql values >>= case _ of execute conn sql values = do
Just pgErr -> pure (Left pgErr) err <- liftAff $ P.execute conn sql values
Nothing -> pure (Right unit) maybe (pure unit) throwError err
-- | Execute a PostgreSQL query and return its results. -- | Execute a PostgreSQL query and return its results.
query query
:: forall i o :: forall i o m
. ToSQLRow i . ToSQLRow i
=> FromSQLRow o => FromSQLRow o
=> MonadError PGError m
=> MonadAff m
=> Connection => Connection
-> Query i o -> Query i o
-> i -> i
-> PG (Array o) -> m (Array o)
query conn sql = ExceptT <<< P.query conn sql query conn sql = hoistAffEither <<< P.query conn sql
-- | Execute a PostgreSQL query and return the first field of the first row in -- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result. -- | the result.
scalar scalar
:: forall i o :: forall i o m
. ToSQLRow i . ToSQLRow i
=> FromSQLValue o => FromSQLValue o
=> MonadError PGError m
=> MonadAff m
=> Connection => Connection
-> Query i (Row1 o) -> Query i (Row1 o)
-> i -> i
-> PG (Maybe o) -> m (Maybe o)
scalar conn sql = ExceptT <<< P.scalar conn sql scalar conn sql = hoistAffEither <<< P.scalar conn sql
-- | Execute a PostgreSQL query and return its command tag value -- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful -- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries. -- | for example with `DELETE` or `UPDATE` queries.
command command
:: forall i :: forall i m
. ToSQLRow i . ToSQLRow i
=> MonadError PGError m
=> MonadAff m
=> Connection => Connection
-> Query i Int -> Query i Int
-> i -> i
-> PG Int -> m Int
command conn sql = ExceptT <<< P.command conn sql 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 = onIntegrityError errorResult db =
catchError db handleError catchError db handleError
where where
@ -131,5 +132,3 @@ onIntegrityError errorResult db =
case e of case e of
IntegrityError _ -> errorResult IntegrityError _ -> errorResult
_ -> throwError e _ -> throwError e

View File

@ -5,7 +5,7 @@ module Test.Main
import Prelude import Prelude
import Control.Monad.Error.Class (throwError, try) 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 Control.Monad.Trans.Class (lift)
import Data.Array (zip) import Data.Array (zip)
import Data.Date (Date, canonicalDate) import Data.Date (Date, canonicalDate)
@ -20,7 +20,8 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) 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 (Effect)
import Effect.Aff (Aff, error, launchAff) import Effect.Aff (Aff, error, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
@ -30,12 +31,19 @@ import Global.Unsafe (unsafeStringify)
import Math ((%)) import Math ((%))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Test.Assert (assert) import Test.Assert (assert)
import Test.README (run) as README
import Test.Unit (TestSuite, suite) import Test.Unit (TestSuite, suite)
import Test.Unit as Test.Unit import Test.Unit as Test.Unit
import Test.Unit.Assert (equal) import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest) 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 :: forall a. Eq a => Show a => a -> a -> PG Unit
pgEqual a b = lift $ equal a b pgEqual a b = lift $ equal a b