Merge pull request #8 from anttih/connection-pooling

Add connection pooling

Author: epost

MODULE.md

@@ -126,13 +126,29 @@ withConnection :: forall eff a. ConnectionInfo -> (Client -> Aff (db :: DB | eff
 Connects to the database, calls the provided function with the client
 and returns the results.
 
+#### `withClient`
+
+``` purescript
+withClient :: forall eff a. ConnectionInfo -> (Client -> Aff (db :: DB | eff) a) -> Aff (db :: DB | eff) a
+```
+
+Takes a Client from the connection pool, runs the given function with
+the client and returns the results.
+
 #### `end`
 
 ``` purescript
 end :: forall eff. Client -> Eff (db :: DB | eff) Unit
 ```
 
 
+#### `disconnect`
+
+``` purescript
+disconnect :: forall eff. Eff (db :: DB | eff) Unit
+```
+
+
 
 ## Module Database.Postgres.SqlValue
 

src/Database/Postgres.purs

@@ -6,18 +6,21 @@ module Database.Postgres
   , ConnectionString()
   , mkConnectionString
   , connect
+  , disconnect
   , end
   , execute, execute_
   , query, query_
   , queryValue, queryValue_
   , queryOne, queryOne_
   , withConnection
+  , withClient
   ) where
 
 import Control.Alt
 import Control.Monad.Eff
 import Control.Monad.Trans
 import Data.Either
+import Data.Function (Fn2(), runFn2)
 import Data.Array
 import Data.Foreign
 import Data.Foreign.Class
@@ -119,6 +122,14 @@ withConnection info p = do
   client <- connect info
   finally (p client) $ liftEff (end client)
 
+-- | Takes a Client from the connection pool, runs the given function with
+-- | the client and returns the results.
+withClient :: forall eff a
+  . ConnectionInfo
+  -> (Client -> Aff (db :: DB | eff) a)
+  -> Aff (db :: DB | eff) a
+withClient info p = runFn2 _withClient (mkConnectionString info) p
+
 liftError :: forall e a. ForeignError -> Aff e a
 liftError err = throwError $ error (show err)
 
@@ -146,6 +157,32 @@ foreign import connect' """
   }
   """ :: forall eff. String -> Aff (db :: DB | eff) Client
 
+foreign import _withClient
+  """
+  function _withClient(conString, cb) {
+    return function(success, error) {
+      var pg = require('pg');
+      pg.connect(conString, function(err, client, done) {
+        if (err) {
+          done(true);
+          return error(err);
+        }
+        cb(client)(function(v) {
+          done();
+          success(v);
+        }, function(err) {
+          done();
+          error(err);
+        })
+      });
+    };
+  }
+  """ :: forall eff a.
+      Fn2
+      ConnectionString
+      (Client -> Aff (db :: DB | eff) a)
+      (Aff (db :: DB | eff) a)
+
 foreign import runQuery_ """
   function runQuery_(queryStr) {
     return function(client) {
@@ -212,3 +249,11 @@ foreign import end """
     };
   }
   """ :: forall eff. Client -> Eff (db :: DB | eff) Unit
+
+foreign import disconnect
+  """
+  function disconnect() {
+    var pg = require('pg');
+    pg.end();
+  }
+  """ :: forall eff. Eff (db :: DB | eff) Unit

test/Main.purs

@@ -26,6 +26,8 @@ main = runAff (trace <<< show) (const $ trace "All ok") $ do
 
   exampleQueries
 
+  liftEff $ disconnect
+
 data Artist = Artist
   { name :: String
   , year :: Number
@@ -63,7 +65,7 @@ exampleError = withConnection connectionInfo $ \c -> do
   queryOne_ (Query "select year from artist") c
 
 exampleQueries :: forall eff. Aff (trace :: Trace, db :: DB | eff) Unit
-exampleQueries = withConnection connectionInfo $ \c -> do
+exampleQueries = withClient connectionInfo $ \c -> do
   liftEff $ trace "Example queries with params:"
   execute_ (Query "delete from artist") c
   execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c