From b102e8ac8f13bcdb42082424d33987a7acf03dfb Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Tue, 10 Nov 2020 17:47:16 +0100 Subject: [PATCH] Make `Connection` a newtype --- README.md | 14 +-- src/Database/PostgreSQL.purs | 2 +- src/Database/PostgreSQL/Aff.purs | 45 ++++--- src/Database/PostgreSQL/PG.purs | 4 +- test/Main.purs | 205 ++++++++++++++++--------------- 5 files changed, 140 insertions(+), 130 deletions(-) diff --git a/README.md b/README.md index 3e39dca..ab8fd62 100644 --- a/README.md +++ b/README.md @@ -19,8 +19,7 @@ module Test.README where import Prelude import Control.Monad.Except.Trans (ExceptT, runExceptT) -import Data.Either (Either(..)) -import Database.PostgreSQL (Connection, Pool, Query(Query), PGError) +import Database.PostgreSQL (Connection, fromPool, Pool, Query(Query), PGError) import Database.PostgreSQL.PG (command, execute, query, withTransaction) as PG import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3)) @@ -70,12 +69,13 @@ We can now create our temporary table which we are going to query in this exampl `PG.execute` ignores result value which is what we want in this case. The last `Row0` value indicates that this `Query` doesn't take any additional parameters. -Database quering functions like `execute` below can perform the action using pool (JS `Pool` instance) -or a connection (js `Client` instance) so they expect a value of type `type Connection = Either Pool Client`. +Database quering functions like `execute` below can perform the action using the pool +or the connection instance so they expect a value of type `Connection` (which is just +a wrapper around `Either` - `newtype Connection = Connection (Either Pool Client)`). ```purescript - PG.execute (Left pool) (Query """ + PG.execute (fromPool pool) (Query """ CREATE TEMPORARY TABLE fruits ( name text NOT NULL, delicious boolean NOT NULL, @@ -123,7 +123,7 @@ data from db. `query` function processes db response and returns an `Array` of rows. ```purescript - names <- PG.query (Left pool) (Query """ + names <- PG.query (fromPool pool) (Query """ SELECT name, delicious FROM fruits ORDER BY name ASC @@ -138,7 +138,7 @@ For example we can have: `DELETE rows`, `UPDATE rows`, `INSERT oid rows` etc. This function should return `rows` value associated with given response. ```purescript - deleted <- PG.command (Left pool) (Query """DELETE FROM fruits """) Row0 + deleted <- PG.command (fromPool pool) (Query """DELETE FROM fruits """) Row0 liftEffect <<< assert $ deleted == 2 ``` diff --git a/src/Database/PostgreSQL.purs b/src/Database/PostgreSQL.purs index aa2188c..5856ae3 100644 --- a/src/Database/PostgreSQL.purs +++ b/src/Database/PostgreSQL.purs @@ -5,7 +5,7 @@ module Database.PostgreSQL , module Value ) where -import Database.PostgreSQL.Aff (Client, ConnectResult, Connection, Query(..), PGError(..), PGErrorDetail) as Aff +import Database.PostgreSQL.Aff (Client, ConnectResult, Connection(..), fromClient, fromPool, Query(..), PGError(..), PGErrorDetail) as Aff import Database.PostgreSQL.Pool (Configuration, Database, parseURI, PGConnectionURI, new, Pool, defaultConfiguration) as Pool import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), fromSQLRow, toSQLRow) as Row import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value diff --git a/src/Database/PostgreSQL/Aff.purs b/src/Database/PostgreSQL/Aff.purs index bcf8e05..9576ea7 100644 --- a/src/Database/PostgreSQL/Aff.purs +++ b/src/Database/PostgreSQL/Aff.purs @@ -1,5 +1,5 @@ module Database.PostgreSQL.Aff - ( Connection + ( Connection(..) , PGError(..) , PGErrorDetail , Client @@ -12,11 +12,14 @@ module Database.PostgreSQL.Aff , withTransaction , command , execute + , fromClient + , fromPool , query , scalar ) where import Prelude + import Control.Monad.Error.Class (catchError, throwError) import Data.Array (head) import Data.Bifunctor (lmap) @@ -74,7 +77,7 @@ withConnection :: Pool -> (Either PGError Connection -> Aff a) -> Aff a -withConnection p k = withClient p (lcmap (map Right) k) +withConnection p k = withClient p (lcmap (map fromClient) k) connect :: Pool -> @@ -109,7 +112,7 @@ withTransaction pool action = withClient pool case _ of Right client -> withClientTransaction client do - (action $ Right client) + (action $ fromClient client) Left err → pure $ Left err -- | TODO: Outdated docs @@ -139,16 +142,22 @@ withClientTransaction client action = Nothing -> pure (Right a) Just pgError -> pure (Left pgError) where - h = Right client + conn = fromClient client - begin = execute h (Query "BEGIN TRANSACTION") Row0 + begin = execute conn (Query "BEGIN TRANSACTION") Row0 - commit = execute h (Query "COMMIT TRANSACTION") Row0 + commit = execute conn (Query "COMMIT TRANSACTION") Row0 - rollback = execute h (Query "ROLLBACK TRANSACTION") Row0 + rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0 -type Connection - = Either Pool Client +newtype Connection = Connection (Either Pool Client) +derive instance newtypeConnection :: Newtype Connection _ + +fromPool :: Pool -> Connection +fromPool pool = Connection (Left pool) + +fromClient :: Client -> Connection +fromClient client = Connection (Right client) -- | APIs of the `Pool.query` and `Client.query` are the same. -- | We can dse this polyformphis to simplify ffi. @@ -162,7 +171,7 @@ execute :: Query i o -> i -> Aff (Maybe PGError) -execute h (Query sql) values = hush <<< either Right Left <$> unsafeQuery h sql (toSQLRow values) +execute conn (Query sql) values = hush <<< either Right Left <$> unsafeQuery conn sql (toSQLRow values) -- | Execute a PostgreSQL query and return its results. query :: @@ -173,8 +182,8 @@ query :: Query i o -> i -> Aff (Either PGError (Array o)) -query h (Query sql) values = do - r <- unsafeQuery h sql (toSQLRow values) +query conn (Query sql) values = do + r <- unsafeQuery conn sql (toSQLRow values) pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError) -- | Execute a PostgreSQL query and return the first field of the first row in @@ -187,7 +196,7 @@ scalar :: Query i (Row1 o) -> i -> Aff (Either PGError (Maybe o)) -scalar h sql values = query h sql values <#> map (head >>> map (case _ of Row1 a -> a)) +scalar conn sql values = query conn sql values <#> map (head >>> map (case _ of Row1 a -> a)) -- | Execute a PostgreSQL query and return its command tag value -- | (how many rows were affected by the query). This may be useful @@ -199,7 +208,7 @@ command :: Query i Int -> i -> Aff (Either PGError Int) -command h (Query sql) values = map _.rowCount <$> unsafeQuery h sql (toSQLRow values) +command conn (Query sql) values = map _.rowCount <$> unsafeQuery conn sql (toSQLRow values) type QueryResult = { rows :: Array (Array Foreign) @@ -211,12 +220,12 @@ unsafeQuery :: String -> Array Foreign -> Aff (Either PGError QueryResult) -unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s +unsafeQuery conn s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler conn) s where toUntaggedHandler ∷ Connection → UntaggedConnection - toUntaggedHandler (Left pool) = unsafeCoerce pool - - toUntaggedHandler (Right client) = unsafeCoerce client + toUntaggedHandler (Connection c) = case c of + (Left pool) -> unsafeCoerce pool + (Right client) -> unsafeCoerce client p = { nullableLeft: toNullable <<< map Left <<< convertError diff --git a/src/Database/PostgreSQL/PG.purs b/src/Database/PostgreSQL/PG.purs index 415dfb1..406517f 100644 --- a/src/Database/PostgreSQL/PG.purs +++ b/src/Database/PostgreSQL/PG.purs @@ -16,7 +16,7 @@ import Control.Monad.Except (class MonadError) import Data.Either (Either(..), either) import Data.Maybe (Maybe, maybe) import Data.Profunctor (lcmap) -import Database.PostgreSQL.Aff (Client, Connection, PGError(..), Query) +import Database.PostgreSQL.Aff (Client, Connection, PGError(..), Query, fromClient) import Database.PostgreSQL.Aff (command, execute, query, scalar, withClient, withClientTransaction, withTransaction) as Aff import Database.PostgreSQL.Pool (Pool) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1) @@ -56,7 +56,7 @@ withConnection :: Pool -> (Connection -> m a) -> m a -withConnection f p k = withClient f p (lcmap Right k) +withConnection f p k = withClient f p (lcmap fromClient k) -- | TODO: Update docs -- | Run an action within a transaction. The transaction is committed if the diff --git a/test/Main.purs b/test/Main.purs index 51dee89..9d4fa4e 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,6 +3,7 @@ module Test.Main ) where import Prelude + import Control.Monad.Error.Class (throwError, try) import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Trans.Class (lift) @@ -21,7 +22,7 @@ import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (unwrap) import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) -import Database.PostgreSQL (Configuration, Client, Connection, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI) +import Database.PostgreSQL (Client, Configuration, Connection(..), PGConnectionURI, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), fromClient, fromPool, parseURI) import Database.PostgreSQL.PG (command, execute, onIntegrityError, query, scalar) import Database.PostgreSQL.PG (withClient, withClientTransaction) as PG import Database.PostgreSQL.Pool (new) as Pool @@ -57,18 +58,18 @@ withRollback ∷ AppM Unit withRollback client action = begin *> action *> rollback where - begin = execute (Right client) (Query "BEGIN TRANSACTION") Row0 + conn = fromClient client + begin = execute conn (Query "BEGIN TRANSACTION") Row0 - rollback = execute (Right client) (Query "ROLLBACK TRANSACTION") Row0 + rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0 test ∷ Connection → String → AppM Unit → TestSuite -test (Left pool) name action = Test.Unit.test name $ checkPGErrors $ action - -test (Right client) name action = Test.Unit.test name $ checkPGErrors $ withRollback client action +test (Connection (Left pool)) name action = Test.Unit.test name $ checkPGErrors $ action +test (Connection (Right client)) name action = Test.Unit.test name $ checkPGErrors $ withRollback client action transactionTest ∷ String → @@ -111,27 +112,27 @@ main = do config ← Config.load pool ← liftEffect $ Pool.new config checkPGErrors - $ execute (Left pool) + $ execute (fromPool pool) ( Query """ - CREATE TEMPORARY TABLE foods ( - name text NOT NULL, - delicious boolean NOT NULL, - price NUMERIC(4,2) NOT NULL, - added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP, - PRIMARY KEY (name) - ); - CREATE TEMPORARY TABLE dates ( - date date NOT NULL - ); - CREATE TEMPORARY TABLE timestamps ( - timestamp timestamptz NOT NULL - ); - CREATE TEMPORARY TABLE jsons ( - json json NOT NULL, - jsonb jsonb NOT NULL - ); - """ + CREATE TEMPORARY TABLE foods ( + name text NOT NULL, + delicious boolean NOT NULL, + price NUMERIC(4,2) NOT NULL, + added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP, + PRIMARY KEY (name) + ); + CREATE TEMPORARY TABLE dates ( + date date NOT NULL + ); + CREATE TEMPORARY TABLE timestamps ( + timestamp timestamptz NOT NULL + ); + CREATE TEMPORARY TABLE jsons ( + json json NOT NULL, + jsonb jsonb NOT NULL + ); + """ ) Row0 checkPGErrors @@ -143,32 +144,32 @@ main = do let testCount n = do count <- - scalar (Left pool) + scalar (fromPool pool) ( Query """ - SELECT count(*) = $1 - FROM foods - """ + SELECT count(*) = $1 + FROM foods + """ ) (Row1 n) liftEffect <<< assert $ count == Just true transactionTest "transaction commit" do withClientTransaction client do - execute (Right client) + execute (fromClient client) ( Query """ - INSERT INTO foods (name, delicious, price) - VALUES ($1, $2, $3) - """ + INSERT INTO foods (name, delicious, price) + VALUES ($1, $2, $3) + """ ) (Row3 "pork" true (D.fromString "8.30")) testCount 1 testCount 1 - execute (Right client) + execute (fromClient client) ( Query """ - DELETE FROM foods - """ + DELETE FROM foods + """ ) Row0 transactionTest "transaction rollback on PostgreSQL error" @@ -176,17 +177,17 @@ main = do _ <- try $ withClientTransaction client do - execute (Right client) + execute (fromClient client) ( Query """ - INSERT INTO foods (name, delicious, price) - VALUES ($1, $2, $3) - """ + INSERT INTO foods (name, delicious, price) + VALUES ($1, $2, $3) + """ ) (Row3 "pork" true (D.fromString "8.30")) testCount 1 -- invalid SQL query --> PGError is thrown - execute (Right client) (Query "foo bar") Row0 + execute (fromClient client) (Query "foo bar") Row0 -- transaction should've been rolled back testCount 0 transactionTest "transaction rollback on JavaScript exception" @@ -194,12 +195,12 @@ main = do result <- lift $ try $ runExceptT $ withClientTransaction client do - execute (Right client) + execute (fromClient client) ( Query """ - INSERT INTO foods (name, delicious, price) - VALUES ($1, $2, $3) - """ + INSERT INTO foods (name, delicious, price) + VALUES ($1, $2, $3) + """ ) (Row3 "pork" true (D.fromString "8.30")) testCount 1 @@ -213,15 +214,15 @@ main = do -- transaction should've been rolled back testCount 0 let - handle = Right client + handle = fromClient client test handle "usage of rows represented by nested tuples" $ do execute handle ( Query """ - INSERT INTO foods (name, delicious, price) - VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) - """ + INSERT INTO foods (name, delicious, price) + VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) + """ ) ( ("pork" /\ true /\ (D.fromString "8.30")) /\ ("sauerkraut" /\ false /\ (D.fromString "3.30")) @@ -231,11 +232,11 @@ main = do query handle ( Query """ - SELECT name, delicious - FROM foods - WHERE delicious - ORDER BY name ASC - """ + SELECT name, delicious + FROM foods + WHERE delicious + ORDER BY name ASC + """ ) Row0 liftEffect <<< assert $ names == [ "pork" /\ true, "rookworst" /\ true ] @@ -246,9 +247,9 @@ main = do execute handle ( Query """ - INSERT INTO dates (date) - VALUES ($1) - """ + INSERT INTO dates (date) + VALUES ($1) + """ ) row rows <- query handle (Query "SELECT date FROM dates") Row0 @@ -258,9 +259,9 @@ main = do execute handle ( Query """ - INSERT INTO foods (name, delicious, price) - VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) - """ + INSERT INTO foods (name, delicious, price) + VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) + """ ) ( Row9 "pork" @@ -280,11 +281,11 @@ main = do query handle ( Query """ - SELECT name, delicious - FROM foods - WHERE delicious - ORDER BY name ASC - """ + SELECT name, delicious + FROM foods + WHERE delicious + ORDER BY name ASC + """ ) Row0 liftEffect <<< assert $ names == [ Row2 "pork" true, Row2 "rookworst" true ] @@ -295,10 +296,10 @@ main = do query handle ( Query """ - DELETE FROM foods - WHERE delicious - RETURNING name, delicious - """ + DELETE FROM foods + WHERE delicious + RETURNING name, delicious + """ ) Row0 liftEffect <<< assert $ deleted == [ Row2 "pork" true, Row2 "rookworst" true ] @@ -309,9 +310,9 @@ main = do command handle ( Query """ - DELETE FROM foods - WHERE delicious - """ + DELETE FROM foods + WHERE delicious + """ ) Row0 liftEffect <<< assert $ deleted == 2 @@ -323,9 +324,9 @@ main = do query handle ( Query """ - SELECT added - FROM foods - """ + SELECT added + FROM foods + """ ) Row0 after <- liftEffect $ (unwrap <<< unInstant) <$> now @@ -346,10 +347,10 @@ main = do query handle ( Query """ - SELECT price - FROM foods - WHERE NOT delicious - """ + SELECT price + FROM foods + WHERE NOT delicious + """ ) Row0 liftEffect <<< assert $ sauerkrautPrice == [ Row1 (D.fromString "3.30") ] @@ -373,19 +374,19 @@ main = do execute handle ( Query """ - INSERT INTO dates (date) - VALUES ($1), ($2), ($3) - """ + INSERT INTO dates (date) + VALUES ($1), ($2), ($3) + """ ) (Row3 d1 d2 d3) (dates :: Array (Row1 Date)) <- query handle ( Query """ - SELECT * - FROM dates - ORDER BY date ASC - """ + SELECT * + FROM dates + ORDER BY date ASC + """ ) Row0 pgEqual 3 (length dates) @@ -399,9 +400,9 @@ main = do execute handle ( Query """ - INSERT INTO jsons (json, jsonb) - VALUES ($1, $2) - """ + INSERT INTO jsons (json, jsonb) + VALUES ($1, $2) + """ ) (Row2 jsonIn jsonIn) (js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0 @@ -413,9 +414,9 @@ main = do execute handle ( Query """ - INSERT INTO jsons (json, jsonb) - VALUES ($1, $2) - """ + INSERT INTO jsons (json, jsonb) + VALUES ($1, $2) + """ ) (Row2 input input) (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 @@ -427,9 +428,9 @@ main = do execute handle ( Query """ - INSERT INTO jsons (json, jsonb) - VALUES ($1, $2) - """ + INSERT INTO jsons (json, jsonb) + VALUES ($1, $2) + """ ) (Row2 input input) (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0 @@ -445,19 +446,19 @@ main = do execute handle ( Query """ - INSERT INTO timestamps (timestamp) - VALUES ($1), ($2), ($3) - """ + INSERT INTO timestamps (timestamp) + VALUES ($1), ($2), ($3) + """ ) (Row3 jsd1 jsd2 jsd3) (timestamps :: Array (Row1 JSDate)) <- query handle ( Query """ - SELECT * - FROM timestamps - ORDER BY timestamp ASC - """ + SELECT * + FROM timestamps + ORDER BY timestamp ASC + """ ) Row0 pgEqual 3 (length timestamps)