Merge pull request #41 from Kamirus/drop-PG-type

Drop PG type, alter PG functions to use typeclass constraints

README.md

@@ -18,11 +18,14 @@ module Test.README where
 
 import Prelude
 
-import Database.PostgreSQL.PG (defaultPoolConfiguration, command, execute, newPool, PG, query, Query(Query), withConnection, withTransaction)
+import Control.Monad.Except.Trans (ExceptT, runExceptT)
+import Database.PostgreSQL.PG (defaultPoolConfiguration, PGError, command, execute, newPool, Pool, Connection, query, Query(Query))
+import Database.PostgreSQL.PG as PG
 import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3))
 import Data.Decimal as Decimal
 import Data.Maybe (Maybe(..))
 import Data.Tuple.Nested ((/\))
+import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Test.Assert (assert)
 ```
@@ -30,14 +33,21 @@ import Test.Assert (assert)
 The whole API for interaction with PostgreSQL is performed asynchronously in `Aff`
 (the only function which runs in plain `Effect` is `newPool`). Core library
 functions usually results in somthing like `Aff (Either PGError a)` which can be easily
-wrapped by user into `ExceptT` or any other custom monad stack. To be honest we provides predifined `ExceptT`
+wrapped by user into `ExceptT` or any other custom monad stack.
-versions of functions in `Database.PostgreSQL.PG` along with some `hoist*` helpers.
+To be honest we provide alternatives to functions in the `Database.PostgreSQL.PG` module that work on any stack `m` with `MonadError PGError m` and `MonadAff m`.
+The module contains two functions `withConnection` and `withTransaction` that require additional parameter - a transformation from a custom monad stack to `Aff (Either PGError a)`.
 We are going to work with `PG` type in this tutorial but please don't consider it as the only option
 if you encounter any troubles integrating it into your own app monad stack.
 
-  ```purescript
+```purescript
-  type PG a = ExceptT PGError Aff a
+type PG a = ExceptT PGError Aff a
-  ```
+
+withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
+withConnection = PG.withConnection runExceptT
+
+withTransaction :: forall a. Connection -> PG a -> PG a
+withTransaction = PG.withTransaction runExceptT
+```
 
 We assume here that Postgres is running on a standard local port
 with `ident` authentication so configuration can be nearly empty (`defaultPoolConfiguration`).

package.json

@@ -0,0 +1,14 @@
+{
+  "name": "purescript-postgresql-client",
+  "dependencies": {
+    "decimal.js": "^10.0.0",
+    "pg": "^6.1.2"
+  },
+  "devDependencies": {
+    "paluh-litps": "^0.1.4"
+  },
+  "scripts": {
+    "pretest": "paluh-litps compile --file README.md; mv README.purs test/README.purs",
+    "test": "spago test"
+  }
+}

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 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 (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
+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
 -- | when the action returns.
 withConnection
-    :: forall a
+    :: forall a m
-     . Pool
+     . MonadError PGError m
-    -> (Connection -> PG a)
+    => MonadAff m
-    -> PG a
+    => (m a -> Aff (Either PGError a))
-withConnection p k = ExceptT $ P.withConnection p case _ of
+    -> Pool
-  Right conn -> runExceptT $ k conn
+    -> (Connection -> m a)
-  Left pgErr -> pure (Left pgErr)
+    -> m a
+withConnection f p 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
+    :: forall a m
-     . Connection
+     . MonadAff m
-    -> PG a
+    => MonadError PGError m
-    -> PG a
+    => (m a -> Aff (Either PGError a))
-withTransaction conn action =
+    -> Connection
-  ExceptT $ join <$> P.withTransaction conn (runExceptT action)
+    -> m a
+    -> m a
+withTransaction f conn 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
+    :: forall i o m
-     . (ToSQLRow i)
+     . ToSQLRow i
+    => MonadError PGError m
+    => MonadAff m
     => Connection
     -> Query i o
     -> 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.
 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)
+    -> 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
 -- | 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)
+    -> 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
 -- | (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
+    -> 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 =
     catchError db handleError
     where
@@ -131,5 +132,3 @@ onIntegrityError errorResult db =
         case e of
             IntegrityError _ -> errorResult
             _ -> throwError e
-
-

test/Main.purs

@@ -20,7 +20,7 @@ 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 Effect (Effect)
 import Effect.Aff (Aff, error, launchAff)
 import Effect.Class (liftEffect)
@@ -30,12 +30,20 @@ import Global.Unsafe (unsafeStringify)
 import Math ((%))
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
-import Test.README (run) as README
+import Test.README (run, PG, withConnection, withTransaction) 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 = README.PG a
+
+withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
+withConnection = README.withConnection
+
+withTransaction :: forall a. Connection -> PG a -> PG a
+withTransaction = README.withTransaction
+
 pgEqual :: forall a. Eq a => Show a => a -> a -> PG Unit
 pgEqual a b = lift $ equal a b