Merge pull request #16 from paluh/master

Upgrade to purescript-aff 4.0.0

bower.json

@@ -6,7 +6,7 @@
     "purescript-transformers": "^3.2.0",
     "purescript-lists": "^4.0.1",
     "purescript-foreign": "^4.0.0",
-    "purescript-aff": "^3.0.0",
+    "purescript-aff": "^4.0.0",
     "purescript-either": "^3.0.0",
     "purescript-maybe": "^3.0.0",
     "purescript-foldable-traversable": "^3.0.0",

src/Database/PostgreSQL.js

@@ -8,18 +8,23 @@ exports.ffiNewPool = function(config) {
     };
 };
 
-exports.ffiConnect = function(pool) {
+exports.ffiConnect = function (pool) {
-    return function(onError) {
+    return function (onError, onSuccess) {
-        return function(onSuccess) {
+        var p = pool.connect(
-            return function() {
+            ).then(function(client) {
-                pool.connect(function(err, client, done) {
+                onSuccess({
-                    if (err != null) {
+                    connection: client,
-                        onError(err)();
+                    done: function() {
-                        return;
+                        return client.release();
                     }
-                    onSuccess({connection: client, done: done})();
                 });
-            };
+            }).catch(function(err) {
+                onError(err);
+            });
+
+        return function (cancelError, cancelerError, cancelerSuccess) {
+          p.cancel();
+          cancelerSuccess();
         };
     };
 };
@@ -27,21 +32,20 @@ exports.ffiConnect = function(pool) {
 exports.ffiUnsafeQuery = function(client) {
     return function(sql) {
         return function(values) {
-            return function(onError) {
+            return function(onError, onSuccess) {
-                return function(onSuccess) {
+                var q = client.query({
-                    return function() {
+                        text: sql,
-                        client.query({
+                        values: values,
-                            text: sql,
+                        rowMode: 'array',
-                            values: values,
+                    }).catch(function(err) {
-                            rowMode: 'array',
+                        onError(err);
-                        }, function(err, result) {
+                    }).then(function(result) {
-                            if (err != null) {
+                        onSuccess(result.rows);
-                                onError(err)();
+                    });
-                                return;
+
-                            }
+                return function (cancelError, cancelerError, cancelerSuccess) {
-                            onSuccess(result.rows)();
+                    q.cancel();
-                        });
+                    cancelerSuccess();
-                    };
                 };
             };
         };

src/Database/PostgreSQL.purs

@@ -15,11 +15,14 @@ module Database.PostgreSQL
 , unsafeQuery
 ) where
 
-import Control.Monad.Aff (Aff, makeAff)
+import Prelude
+
+import Control.Monad.Aff (Aff, bracket)
+import Control.Monad.Aff.Compat (EffFnAff, fromEffFnAff)
 import Control.Monad.Eff (kind Effect, Eff)
 import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Exception (Error, error)
+import Control.Monad.Eff.Exception (error)
-import Control.Monad.Error.Class (catchError, throwError, withResource)
+import Control.Monad.Error.Class (catchError, throwError)
 import Data.Array (head)
 import Data.Either (Either(..))
 import Data.Foreign (Foreign)
@@ -30,7 +33,6 @@ import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1
 import Database.PostgreSQL.Row as Row
 import Database.PostgreSQL.Value (class FromSQLValue)
 import Database.PostgreSQL.Value as Value
-import Prelude
 
 foreign import data POSTGRESQL :: Effect
 
@@ -73,20 +75,31 @@ withConnection
     -> (Connection -> Aff (postgreSQL :: POSTGRESQL | eff) a)
     -> Aff (postgreSQL :: POSTGRESQL | eff) a
 withConnection p k =
-  withResource (makeAff $ ffiConnect p)
+  bracket
-               (liftEff <<< _.done)
+    (connect p)
-               (k <<< _.connection)
+    (liftEff <<< _.done)
+    (k <<< _.connection)
 
-foreign import ffiConnect
+type PostgreSqlEff eff  = (postgreSQL :: POSTGRESQL | eff)
+
+connect
     :: ∀ eff
      . Pool
-    -> (Error -> Eff (postgreSQL :: POSTGRESQL | eff) Unit)
+    -> Aff
-    -> (    { connection :: Connection
+      (postgreSQL :: POSTGRESQL | eff)
-            , done :: Eff (postgreSQL :: POSTGRESQL | eff) Unit
+      { connection :: Connection
-            }
+      , done :: Eff (PostgreSqlEff eff) Unit
-         -> Eff (postgreSQL :: POSTGRESQL | eff) Unit
+      }
-       )
+connect = fromEffFnAff <<< ffiConnect
-    -> Eff (postgreSQL :: POSTGRESQL | eff) Unit
+
+foreign import ffiConnect
+  :: ∀ eff
+   . Pool
+  -> EffFnAff
+      (PostgreSqlEff eff)
+      { connection :: Connection
+      , done :: Eff (PostgreSqlEff eff) Unit
+      }
 
 -- | Run an action within a transaction. The transaction is committed if the
 -- | action returns, and rolled back when the action throws. If you want to
@@ -144,21 +157,19 @@ scalar conn sql values =
     <#> map (case _ of Row1 a -> a) <<< head
 
 unsafeQuery
-  :: ∀ eff
+    :: ∀ eff
-   . Connection
+     . Connection
-  -> String
+    -> String
-  -> Array Foreign
+    -> Array Foreign
-  -> Aff (postgreSQL :: POSTGRESQL | eff) (Array (Array Foreign))
+    -> Aff (postgreSQL :: POSTGRESQL | eff) (Array (Array Foreign))
-unsafeQuery c s a = makeAff $ ffiUnsafeQuery c s a
+unsafeQuery c s = fromEffFnAff <<< ffiUnsafeQuery c s
 
 foreign import ffiUnsafeQuery
     :: ∀ eff
      . Connection
     -> String
     -> Array Foreign
-    -> (Error -> Eff (postgreSQL :: POSTGRESQL | eff) Unit)
+    -> EffFnAff (postgreSQL :: POSTGRESQL | eff) (Array (Array Foreign))
-    -> (Array (Array Foreign) -> Eff (postgreSQL :: POSTGRESQL | eff) Unit)
-    -> Eff (postgreSQL :: POSTGRESQL | eff) Unit
 
 fromRight :: ∀ a b. Either a b -> Maybe b
 fromRight (Left _) = Nothing

test/Main.purs

@@ -2,14 +2,15 @@ module Test.Main
   ( main
   ) where
 
+import Prelude
+
 import Control.Monad.Aff (launchAff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Exception (EXCEPTION, error)
 import Control.Monad.Error.Class (throwError, try)
 import Data.Maybe (Maybe(..))
-import Database.PostgreSQL (POSTGRESQL, PoolConfiguration, Query(..), Row0(..), Row1(..), Row2(..), Row6(..), execute, newPool, query, scalar, withConnection, withTransaction)
+import Database.PostgreSQL (POSTGRESQL, Query(..), PoolConfiguration, execute, newPool, query, Row0(..), Row1(..), Row2(..), Row6(..), scalar, withConnection, withTransaction)
-import Prelude
 import Test.Assert (ASSERT, assert)
 
 main :: ∀ eff. Eff (assert :: ASSERT, exception :: EXCEPTION, postgreSQL :: POSTGRESQL | eff) Unit
@@ -17,11 +18,11 @@ main = void $ launchAff do
   pool <- newPool config
   withConnection pool \conn -> do
     execute conn (Query """
-      CREATE TEMPORARY TABLE foods (
+     CREATE TEMPORARY TABLE foods (
-        name text NOT NULL,
+       name text NOT NULL,
-        delicious boolean NOT NULL,
+       delicious boolean NOT NULL,
-        PRIMARY KEY (name)
+       PRIMARY KEY (name)
-      )
+     )
     """) Row0
 
     execute conn (Query """
@@ -35,6 +36,7 @@ main = void $ launchAff do
       WHERE delicious
       ORDER BY name ASC
     """) Row0
+
     liftEff <<< assert $ names == [Row1 "pork", Row1 "rookworst"]
 
     testTransactionCommit conn