From 274110cdad1b2c5ddbbb1d693d8c00043d1054b8 Mon Sep 17 00:00:00 2001 From: justinwoo Date: Sun, 1 Oct 2017 16:30:43 +0300 Subject: [PATCH 1/2] Upgrade to Aff 4.0 --- bower.json | 24 ++++++++++++------------ src/Database/Postgres.purs | 24 +++++++++++++----------- test/Main.purs | 5 +---- 3 files changed, 26 insertions(+), 27 deletions(-) diff --git a/bower.json b/bower.json index b239b93..7234be4 100644 --- a/bower.json +++ b/bower.json @@ -26,22 +26,22 @@ "output" ], "dependencies": { - "purescript-arrays": "^4.0.0", - "purescript-either": "^3.0.0", - "purescript-foreign": "^4.0.0", - "purescript-foldable-traversable": "^3.0.0", - "purescript-transformers": "^3.0.0", - "purescript-aff": "^3.0.0", - "purescript-integers": "^3.0.0", - "purescript-datetime": "^3.0.0", + "purescript-arrays": "^4.2.1", + "purescript-either": "^3.1.0", + "purescript-foreign": "^4.0.1", + "purescript-foldable-traversable": "^3.6.1", + "purescript-transformers": "^3.4.0", + "purescript-aff": "^4.0.0", + "purescript-integers": "^3.1.0", + "purescript-datetime": "^3.4.0", "purescript-unsafe-coerce": "^3.0.0", "purescript-nullable": "^3.0.0", - "purescript-prelude": "^3.0.0", - "purescript-foreign-generic": "^4.0.0" + "purescript-prelude": "^3.1.0", + "purescript-foreign-generic": "^5.0.0" }, "devDependencies": { - "purescript-spec": "^1.0.0", + "purescript-spec": "git@github.com:justinwoo/purescript-spec.git#3a0ac612af654ff74e9183fd1d46b8ef8b505f8f", "purescript-generics": "^4.0.0", - "purescript-js-date": "^4.0.0" + "purescript-js-date": "^5.1.0" } } diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs index b6642d0..8641507 100644 --- a/src/Database/Postgres.purs +++ b/src/Database/Postgres.purs @@ -17,20 +17,20 @@ module Database.Postgres ) where import Prelude + +import Control.Monad.Aff (Aff, bracket) import Control.Monad.Eff (kind Effect, Eff) -import Data.Either (Either, either) -import Data.Function.Uncurried (Fn2(), runFn2) +import Control.Monad.Eff.Class (liftEff) +import Control.Monad.Eff.Exception (error) +import Control.Monad.Error.Class (throwError) +import Control.Monad.Except (runExcept) import Data.Array ((!!)) +import Data.Either (Either, either) import Data.Foreign (Foreign, MultipleErrors) import Data.Foreign.Class (class Decode, decode) +import Data.Function.Uncurried (Fn2, runFn2) import Data.Maybe (Maybe(Just, Nothing), maybe) -import Control.Monad.Except (runExcept) -import Control.Monad.Aff (Aff, finally) -import Control.Monad.Eff.Class (liftEff) -import Control.Monad.Eff.Exception (error) -import Control.Monad.Error.Class (throwError) import Data.Traversable (sequence) - import Database.Postgres.SqlValue (SqlValue) newtype Query a = Query String @@ -118,9 +118,11 @@ withConnection :: forall eff a . ConnectionInfo -> (Client -> Aff (db :: DB | eff) a) -> Aff (db :: DB | eff) a -withConnection info p = do - client <- connect info - finally (p client) $ liftEff (end client) +withConnection info p = + bracket + (connect info) + (liftEff <<< end) + p -- | Takes a Client from the connection pool, runs the given function with -- | the client and returns the results. diff --git a/test/Main.purs b/test/Main.purs index 89bbc6b..88ff634 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,7 +8,6 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Class (liftEff) import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (error) -import Control.Monad.Eff.Timer (TIMER) import Control.Monad.Error.Class (throwError) import Data.Array (length) import Data.Date (canonicalDate) @@ -26,11 +25,10 @@ import Data.Time (Time(..)) import Database.Postgres (DB, Query(Query), connect, end, execute, execute_, mkConnectionString, query, queryOne_, queryValue_, query_, withClient, withConnection) import Database.Postgres.SqlValue (toSql) import Database.Postgres.Transaction (withTransaction) -import Node.Process (PROCESS) import Test.Spec (describe, it) import Test.Spec.Assertions (fail, shouldEqual) import Test.Spec.Reporter.Console (consoleReporter) -import Test.Spec.Runner (run) +import Test.Spec.Runner (PROCESS, run) import Unsafe.Coerce (unsafeCoerce) data Artist = Artist @@ -50,7 +48,6 @@ connectionInfo = main :: forall eff. Eff ( console :: CONSOLE - , timer :: TIMER , avar :: AVAR , process :: PROCESS , db :: DB From 86ae9a5cb7ddb5ce75f2621c5afc2e5f776240ce Mon Sep 17 00:00:00 2001 From: Tony DiPasquale Date: Thu, 5 Oct 2017 20:10:36 -0700 Subject: [PATCH 2/2] Update code to use new Aff 4.0 APIs --- bower.json | 4 +- src/Database/Postgres.js | 83 ++++++++++----------- src/Database/Postgres.purs | 143 ++++++++++++++++++++++--------------- test/Main.purs | 56 +++++++++------ 4 files changed, 166 insertions(+), 120 deletions(-) diff --git a/bower.json b/bower.json index 7234be4..3694baa 100644 --- a/bower.json +++ b/bower.json @@ -1,6 +1,6 @@ { "name": "purescript-node-postgres", - "version": "2.0.0", + "version": "4.0.0", "moduleType": [ "node" ], @@ -40,7 +40,7 @@ "purescript-foreign-generic": "^5.0.0" }, "devDependencies": { - "purescript-spec": "git@github.com:justinwoo/purescript-spec.git#3a0ac612af654ff74e9183fd1d46b8ef8b505f8f", + "purescript-spec": "^2.0.0", "purescript-generics": "^4.0.0", "purescript-js-date": "^5.1.0" } diff --git a/src/Database/Postgres.js b/src/Database/Postgres.js index 202a142..4e585e4 100644 --- a/src/Database/Postgres.js +++ b/src/Database/Postgres.js @@ -3,95 +3,98 @@ var pg = require('pg'); -exports["connect'"] = function (conString) { - return function(success, error) { - var client = new pg.Client(conString); - client.connect(function(err) { - if (err) { - error(err); - } else { - success(client); - } - }) - return client; +exports.mkPool = function (conInfo) { + return function () { + return new pg.Pool(conInfo); }; } -exports._withClient = function (conString, cb) { - return function(success, error) { - pg.connect(conString, function(err, client, done) { +exports["connect'"] = function (pool) { + return function(error, success) { + pool.connect(function(err, client) { if (err) { - done(true); - return error(err); - } - cb(client)(function(v) { - done(); - success(v); - }, function(err) { - done(); error(err); - }) + } else { + success(client); + } }); + return function(cancelError, onCancelerError, onCancelerSuccess) { + onCancelerSuccess(); + }; }; } -exports.runQuery_ = function (queryStr) { +exports.runQuery_ = function(queryStr) { return function(client) { - return function(success, error) { + return function(error, success) { client.query(queryStr, function(err, result) { if (err) { error(err); } else { success(result.rows); } - }) + }); + return function(cancelError, onCancelerError, onCancelerSuccess) { + onCancelerSuccess(); + }; }; }; } -exports.runQuery = function (queryStr) { +exports.runQuery = function(queryStr) { return function(params) { return function(client) { - return function(success, error) { + return function(error, success) { client.query(queryStr, params, function(err, result) { if (err) return error(err); success(result.rows); - }) + }); + return function(cancelError, onCancelerError, onCancelerSuccess) { + onCancelerSuccess(); + }; }; }; }; } -exports.runQueryValue_ = function (queryStr) { +exports.runQueryValue_ = function(queryStr) { return function(client) { - return function(success, error) { + return function(error, success) { client.query(queryStr, function(err, result) { if (err) return error(err); success(result.rows.length > 0 ? result.rows[0][result.fields[0].name] : undefined); - }) + }); + return function(cancelError, onCancelerError, onCancelerSuccess) { + onCancelerSuccess(); + }; }; }; } -exports.runQueryValue = function (queryStr) { +exports.runQueryValue = function(queryStr) { return function(params) { return function(client) { - return function(success, error) { + return function(error, success) { client.query(queryStr, params, function(err, result) { if (err) return error(err); success(result.rows.length > 0 ? result.rows[0][result.fields[0].name] : undefined); - }) + }); + return function(cancelError, onCancelerError, onCancelerSuccess) { + onCancelerSuccess(); + }; }; }; }; } -exports.end = function (client) { - return function() { - client.end(); +exports.release = function (client) { + return function () { + client.release(); }; } -exports.disconnect = function () { - pg.end(); +exports.end = function(pool) { + return function() { + pool.end(); + }; } diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs index 8641507..84d57e3 100644 --- a/src/Database/Postgres.purs +++ b/src/Database/Postgres.purs @@ -1,24 +1,30 @@ module Database.Postgres ( Query(..) - , Client() - , DB() - , ConnectionInfo() - , ConnectionString() - , mkConnectionString + , Client + , Pool + , DB + , ConnectionInfo + , ClientConfig + , PoolConfig + , ConnectionString + , connectionInfoFromConfig + , connectionInfoFromString + , defaultPoolConfig , connect - , disconnect + , release , end , execute, execute_ , query, query_ , queryValue, queryValue_ , queryOne, queryOne_ - , withConnection , withClient + , mkPool ) where 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) @@ -28,128 +34,149 @@ import Data.Array ((!!)) import Data.Either (Either, either) import Data.Foreign (Foreign, MultipleErrors) import Data.Foreign.Class (class Decode, decode) -import Data.Function.Uncurried (Fn2, runFn2) import Data.Maybe (Maybe(Just, Nothing), maybe) import Data.Traversable (sequence) import Database.Postgres.SqlValue (SqlValue) +import Unsafe.Coerce (unsafeCoerce) newtype Query a = Query String +foreign import data Pool :: Type + foreign import data Client :: Type foreign import data DB :: Effect +foreign import data ConnectionInfo :: Type + type ConnectionString = String -type ConnectionInfo = +connectionInfoFromString :: ConnectionString -> ConnectionInfo +connectionInfoFromString s = unsafeCoerce { connectionString: s } + +type ClientConfig = { host :: String - , db :: String + , database :: String , port :: Int , user :: String , password :: String + , ssl :: Boolean } -mkConnectionString :: ConnectionInfo -> ConnectionString -mkConnectionString ci = - "postgres://" - <> ci.user <> ":" - <> ci.password <> "@" - <> ci.host <> ":" - <> show ci.port <> "/" - <> ci.db +type PoolConfig = + { connectionTimeoutMillis :: Int + , idleTimeoutMillis :: Int + , max :: Int + } --- | Makes a connection to the database. -connect :: forall eff. ConnectionInfo -> Aff (db :: DB | eff) Client -connect = connect' <<< mkConnectionString +defaultPoolConfig :: PoolConfig +defaultPoolConfig = + { connectionTimeoutMillis: 0 + , idleTimeoutMillis: 30000 + , max: 10 + } + +connectionInfoFromConfig :: ClientConfig -> PoolConfig -> ConnectionInfo +connectionInfoFromConfig c p = unsafeCoerce + { host: c.host + , database: c.database + , port: c.port + , user: c.user + , password: c.password + , ssl: c.ssl + , connectionTimeoutMillis: p.connectionTimeoutMillis + , idleTimeoutMillis: p.idleTimeoutMillis + , max: p.max + } + +-- | Makes a connection to the database via a Client. +connect :: forall eff. Pool -> Aff (db :: DB | eff) Client +connect = fromEffFnAff <<< connect' -- | Runs a query and returns nothing. execute :: forall eff a. Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) Unit -execute (Query sql) params client = void $ runQuery sql params client +execute (Query sql) params client = void $ fromEffFnAff $ runQuery sql params client -- | Runs a query and returns nothing execute_ :: forall eff a. Query a -> Client -> Aff (db :: DB | eff) Unit -execute_ (Query sql) client = void $ runQuery_ sql client +execute_ (Query sql) client = void $ fromEffFnAff $ runQuery_ sql client -- | Runs a query and returns all results. query :: forall eff a - . (Decode a) + . Decode a => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Array a) query (Query sql) params client = do - rows <- runQuery sql params client + rows <- fromEffFnAff $ runQuery sql params client either liftError pure (runExcept (sequence $ decode <$> rows)) -- | Just like `query` but does not make any param replacement -query_ :: forall eff a. (Decode a) => Query a -> Client -> Aff (db :: DB | eff) (Array a) +query_ :: forall eff a + . Decode a + => Query a -> Client -> Aff (db :: DB | eff) (Array a) query_ (Query sql) client = do - rows <- runQuery_ sql client + rows <- fromEffFnAff $ runQuery_ sql client either liftError pure (runExcept (sequence $ decode <$> rows)) -- | Runs a query and returns the first row, if any queryOne :: forall eff a - . (Decode a) + . Decode a => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Maybe a) queryOne (Query sql) params client = do - rows <- runQuery sql params client + rows <- fromEffFnAff $ runQuery sql params client maybe (pure Nothing) (either liftError (pure <<< Just)) (decodeFirst rows) -- | Just like `queryOne` but does not make any param replacement -queryOne_ :: forall eff a. (Decode a) => Query a -> Client -> Aff (db :: DB | eff) (Maybe a) +queryOne_ :: forall eff a + . Decode a + => Query a -> Client -> Aff (db :: DB | eff) (Maybe a) queryOne_ (Query sql) client = do - rows <- runQuery_ sql client + rows <- fromEffFnAff $ runQuery_ sql client maybe (pure Nothing) (either liftError (pure <<< Just)) (decodeFirst rows) -- | Runs a query and returns a single value, if any. queryValue :: forall eff a - . (Decode a) + . Decode a => Query a -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Maybe a) queryValue (Query sql) params client = do - val <- runQueryValue sql params client + val <- fromEffFnAff $ runQueryValue sql params client pure $ either (const Nothing) Just (runExcept (decode val)) -- | Just like `queryValue` but does not make any param replacement -queryValue_ :: forall eff a. (Decode a) => Query a -> Client -> Aff (db :: DB | eff) (Maybe a) +queryValue_ :: forall eff a + . Decode a + => Query a -> Client -> Aff (db :: DB | eff) (Maybe a) queryValue_ (Query sql) client = do - val <- runQueryValue_ sql client + val <- fromEffFnAff $ runQueryValue_ sql client either liftError (pure <<< Just) $ runExcept (decode val) -- | Connects to the database, calls the provided function with the client -- | and returns the results. -withConnection :: forall eff a - . ConnectionInfo - -> (Client -> Aff (db :: DB | eff) a) - -> Aff (db :: DB | eff) a -withConnection info p = +withClient :: forall eff a + . Pool -> (Client -> Aff (db :: DB | eff) a) -> Aff (db :: DB | eff) a +withClient pool p = bracket - (connect info) - (liftEff <<< end) + (connect pool) + (liftEff <<< release) p --- | 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 - decodeFirst :: forall a. Decode a => Array Foreign -> Maybe (Either MultipleErrors a) decodeFirst rows = runExcept <<< decode <$> (rows !! 0) liftError :: forall e a. MultipleErrors -> Aff e a liftError errs = throwError $ error (show errs) -foreign import connect' :: forall eff. String -> Aff (db :: DB | eff) Client +foreign import mkPool :: forall eff. ConnectionInfo -> Eff (db :: DB | eff) Pool -foreign import _withClient :: forall eff a. Fn2 ConnectionString (Client -> Aff (db :: DB | eff) a) (Aff (db :: DB | eff) a) +foreign import connect' :: forall eff. Pool -> EffFnAff (db :: DB | eff) Client -foreign import runQuery_ :: forall eff. String -> Client -> Aff (db :: DB | eff) (Array Foreign) +foreign import runQuery_ :: forall eff. String -> Client -> EffFnAff (db :: DB | eff) (Array Foreign) -foreign import runQuery :: forall eff. String -> Array SqlValue -> Client -> Aff (db :: DB | eff) (Array Foreign) +foreign import runQuery :: forall eff. String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff) (Array Foreign) -foreign import runQueryValue_ :: forall eff. String -> Client -> Aff (db :: DB | eff) Foreign +foreign import runQueryValue_ :: forall eff. String -> Client -> EffFnAff (db :: DB | eff) Foreign -foreign import runQueryValue :: forall eff. String -> Array SqlValue -> Client -> Aff (db :: DB | eff) Foreign +foreign import runQueryValue :: forall eff. String -> Array SqlValue -> Client -> EffFnAff (db :: DB | eff) Foreign -foreign import end :: forall eff. Client -> Eff (db :: DB | eff) Unit +foreign import release :: forall eff. Client -> Eff (db :: DB | eff) Unit -foreign import disconnect :: forall eff. Eff (db :: DB | eff) Unit +foreign import end :: forall eff. Pool -> Eff (db :: DB | eff) Unit diff --git a/test/Main.purs b/test/Main.purs index 88ff634..733a1ab 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -22,7 +22,9 @@ import Data.Generic (class Generic, gEq) import Data.JSDate (toDateTime) import Data.Maybe (Maybe(Nothing, Just), maybe) import Data.Time (Time(..)) -import Database.Postgres (DB, Query(Query), connect, end, execute, execute_, mkConnectionString, query, queryOne_, queryValue_, query_, withClient, withConnection) +import Database.Postgres (DB, Query(Query), connect, end, execute, execute_, + query, queryOne_, queryValue_, query_, withClient, ClientConfig, + ConnectionInfo, connectionInfoFromConfig, defaultPoolConfig, mkPool, release) import Database.Postgres.SqlValue (toSql) import Database.Postgres.Transaction (withTransaction) import Test.Spec (describe, it) @@ -36,15 +38,19 @@ data Artist = Artist , year :: Int } -connectionInfo :: { host :: String, db :: String, port :: Int, user :: String, password :: String } -connectionInfo = +clientConfig :: ClientConfig +clientConfig = { host: "localhost" - , db: "test" + , database: "test" , port: 5432 , user: "testuser" , password: "test" + , ssl: false } +connectionInfo :: ConnectionInfo +connectionInfo = connectionInfoFromConfig clientConfig defaultPoolConfig + main :: forall eff. Eff ( console :: CONSOLE @@ -55,13 +61,10 @@ main :: forall eff. ) Unit main = run [consoleReporter] do - describe "connection string" do - it "should build one from the connection record" do - mkConnectionString connectionInfo `shouldEqual` "postgres://testuser:test@localhost:5432/test" - - describe "withConnection" do - it "Returns a connection" do - withConnection connectionInfo $ \c -> do + describe "withClient" do + it "Returns a client" do + pool <- liftEff $ mkPool connectionInfo + withClient pool $ \c -> do execute_ (Query "delete from artist") c execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c execute_ (Query "insert into artist values ('Deep Purple', 1968)") c @@ -74,17 +77,20 @@ main = run [consoleReporter] do artists <- query_ (Query "select * from artist" :: Query Artist) c length artists `shouldEqual` 3 + liftEff $ end pool describe "Low level API" do it "Can be used to manage connections manually" do - client <- connect connectionInfo + pool <- liftEff $ mkPool connectionInfo + client <- connect pool execute_ (Query "delete from artist") client execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") client artists <- query_ (Query "select * from artist order by name desc" :: Query Artist) client artists `shouldEqual` [Artist { name: "Led Zeppelin", year: 1968 }] - liftEff $ end client + liftEff $ release client + liftEff $ end pool describe "Error handling" do it "When query cannot be converted to the requested data type we get an error" do @@ -93,7 +99,8 @@ main = run [consoleReporter] do describe "Query params" do it "Select using a query param" do - withClient connectionInfo $ \c -> do + pool <- liftEff $ mkPool connectionInfo + withClient pool $ \c -> do execute_ (Query "delete from artist") c execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c execute_ (Query "insert into artist values ('Deep Purple', 1968)") c @@ -103,10 +110,12 @@ main = run [consoleReporter] do noRows <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "FAIL"] c length noRows `shouldEqual` 0 + liftEff $ end pool describe "data types" do it "datetimes can be inserted" do - withConnection connectionInfo \c -> do + pool <- liftEff $ mkPool connectionInfo + withClient pool \c -> do execute_ (Query "delete from types") c let date = canonicalDate <$> toEnum 2016 <*> Just January <*> toEnum 25 time = Time <$> toEnum 23 <*> toEnum 1 <*> toEnum 59 <*> toEnum 0 @@ -117,26 +126,33 @@ main = run [consoleReporter] do let res = unsafeCoerce <$> ts' >>= toDateTime res `shouldEqual` (Just ts) ) dt + liftEff $ end pool describe "transactions" do it "does not commit after an error inside a transation" do - withConnection connectionInfo $ \c -> do + pool <- liftEff $ mkPool connectionInfo + withClient pool $ \c -> do execute_ (Query "delete from artist") c apathize $ tryInsert c one <- queryOne_ (Query "select * from artist" :: Query Artist) c one `shouldEqual` Nothing + liftEff $ end pool where tryInsert = withTransaction $ \c -> do execute_ (Query "insert into artist values ('Not there', 1999)") c throwError $ error "fail" exampleError :: forall eff. Aff (db :: DB | eff) (Maybe Artist) -exampleError = withConnection connectionInfo $ \c -> do - execute_ (Query "delete from artist") c - execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c - queryOne_ (Query "select year from artist") c +exampleError = do + pool <- liftEff $ mkPool connectionInfo + withClient pool $ \c -> do + execute_ (Query "delete from artist") c + execute_ (Query "insert into artist values ('Led Zeppelin', 1968)") c + result <- queryOne_ (Query "select year from artist") c + liftEff $ end pool + pure result instance artistShow :: Show Artist where show (Artist p) = "Artist (" <> p.name <> ", " <> show p.year <> ")"