From feadfc26946a3d64aa8520c37ea49997292512a4 Mon Sep 17 00:00:00 2001 From: rightfold Date: Sat, 3 Jun 2017 13:43:30 +0200 Subject: [PATCH] Use makeAff instead of importing PS in FFI code --- bower.json | 2 +- src/Database/PostgreSQL.js | 72 +++++++++++++++++------------------- src/Database/PostgreSQL.purs | 54 +++++++++++++++++++++------ 3 files changed, 78 insertions(+), 50 deletions(-) diff --git a/bower.json b/bower.json index b4a39dd..c961551 100644 --- a/bower.json +++ b/bower.json @@ -3,7 +3,7 @@ "license": "BSD-3-Clause", "dependencies": { "purescript-prelude": "^3.0.0", - "purescript-transformers": "^3.1.0", + "purescript-transformers": "^3.2.0", "purescript-lists": "^4.0.1", "purescript-foreign": "^4.0.0", "purescript-aff": "^3.0.0", diff --git a/src/Database/PostgreSQL.js b/src/Database/PostgreSQL.js index 033ad4a..7c7aeff 100644 --- a/src/Database/PostgreSQL.js +++ b/src/Database/PostgreSQL.js @@ -1,52 +1,48 @@ 'use strict'; -var Control_Monad_Aff = require('../Control.Monad.Aff'); var pg = require('pg'); -exports.newPool = function(config) { - return function(onSuccess, onError) { - onSuccess(new pg.Pool(config)); - return Control_Monad_Aff.nonCanceler; +exports.ffiNewPool = function(config) { + return function() { + return new pg.Pool(config); }; }; -exports.withConnection = function(pool) { - return function(body) { - return function(onSuccess, onError) { - pool.connect(function(err, client, done) { - if (err !== null) { - onError(err); - return; - } - body(client)(function(r) { - done(); - onSuccess(r); - }, function(e) { - done(e); - onError(e); - }); - }); - return Control_Monad_Aff.nonCanceler; - }; - }; -}; - -exports._query = function(client) { - return function(sql) { - return function(values) { - return function(onSuccess, onError) { - client.query({ - text: sql, - values: values, - rowMode: 'array', - }, function(err, result) { +exports.ffiConnect = function(pool) { + return function(onError) { + return function(onSuccess) { + return function() { + pool.connect(function(err, client, done) { if (err !== null) { - onError(err); + onError(err)(); return; } - onSuccess(result.rows); + onSuccess({connection: client, done: done})(); }); - return Control_Monad_Aff.nonCanceler; + }; + }; + }; +}; + +exports.ffiUnsafeQuery = function(client) { + return function(sql) { + return function(values) { + return function(onError) { + return function(onSuccess) { + return function() { + client.query({ + text: sql, + values: values, + rowMode: 'array', + }, function(err, result) { + if (err !== null) { + onError(err)(); + return; + } + onSuccess(result.rows)(); + }); + }; + }; }; }; }; diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index 4c7bd8c..f2f352e 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -12,12 +12,14 @@ module Database.PostgreSQL , execute , query , scalar +, unsafeQuery ) where -import Control.Monad.Aff (Aff) -import Control.Monad.Eff (kind Effect) -import Control.Monad.Eff.Exception (error) -import Control.Monad.Error.Class (catchError, throwError) +import Control.Monad.Aff (Aff, makeAff) +import Control.Monad.Eff (kind Effect, Eff) +import Control.Monad.Eff.Class (liftEff) +import Control.Monad.Eff.Exception (Error, error) +import Control.Monad.Error.Class (catchError, throwError, withResource) import Data.Array (head) import Data.Either (Either(..)) import Data.Foreign (Foreign) @@ -55,18 +57,36 @@ newtype Query i o = Query String derive instance newtypeQuery :: Newtype (Query i o) _ -- | Create a new connection pool. -foreign import newPool +newPool :: ∀ eff. PoolConfiguration -> Aff (postgreSQL :: POSTGRESQL | eff) Pool +newPool = liftEff <<< ffiNewPool + +foreign import ffiNewPool :: ∀ eff . PoolConfiguration - -> Aff (postgreSQL :: POSTGRESQL | eff) Pool + -> Eff (postgreSQL :: POSTGRESQL | eff) Pool -- | Run an action with a connection. The connection is released to the pool -- | when the action returns. -foreign import withConnection +withConnection :: ∀ eff a . Pool -> (Connection -> Aff (postgreSQL :: POSTGRESQL | eff) a) -> Aff (postgreSQL :: POSTGRESQL | eff) a +withConnection p k = + withResource (makeAff $ ffiConnect p) + (liftEff <<< _.done) + (k <<< _.connection) + +foreign import ffiConnect + :: ∀ eff + . Pool + -> (Error -> Eff (postgreSQL :: POSTGRESQL | eff) Unit) + -> ( { connection :: Connection + , done :: Eff (postgreSQL :: POSTGRESQL | eff) Unit + } + -> Eff (postgreSQL :: POSTGRESQL | eff) Unit + ) + -> Eff (postgreSQL :: POSTGRESQL | 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 @@ -92,7 +112,7 @@ execute -> i -> Aff (postgreSQL :: POSTGRESQL | eff) Unit execute conn (Query sql) values = - void $ _query conn sql (toSQLRow values) + void $ unsafeQuery conn sql (toSQLRow values) -- | Execute a PostgreSQL query and return its results. query @@ -104,11 +124,13 @@ query -> i -> Aff (postgreSQL :: POSTGRESQL | eff) (Array o) query conn (Query sql) values = - _query conn sql (toSQLRow values) + unsafeQuery conn sql (toSQLRow values) >>= traverse (fromSQLRow >>> case _ of Right row -> pure row Left msg -> throwError (error msg)) +-- | Execute a PostgreSQL query and return the first field of the first row in +-- | the result. scalar :: ∀ i o eff . ToSQLRow i @@ -121,12 +143,22 @@ scalar conn sql values = query conn sql values <#> map (case _ of Row1 a -> a) <<< head -foreign import _query +unsafeQuery + :: ∀ eff + . Connection + -> String + -> Array Foreign + -> Aff (postgreSQL :: POSTGRESQL | eff) (Array (Array Foreign)) +unsafeQuery c s a = makeAff $ ffiUnsafeQuery c s a + +foreign import ffiUnsafeQuery :: ∀ eff . Connection -> String -> Array Foreign - -> Aff (postgreSQL :: POSTGRESQL | eff) (Array (Array Foreign)) + -> (Error -> Eff (postgreSQL :: POSTGRESQL | eff) Unit) + -> (Array (Array Foreign) -> Eff (postgreSQL :: POSTGRESQL | eff) Unit) + -> Eff (postgreSQL :: POSTGRESQL | eff) Unit fromRight :: ∀ a b. Either a b -> Maybe b fromRight (Left _) = Nothing