thunderstrike/purescript-postgresql-client
thunderstrike/purescript-postgresql-client
2
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make Connection a newtype

Browse Source
This commit is contained in:
Tomasz Rybarczyk 2020-11-10 17:47:16 +01:00
parent dd0011687c
commit b102e8ac8f
5 changed files with 140 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
README.md
View File

@ -19,8 +19,7 @@ module Test.README where
import Prelude import Prelude
import Control.Monad.Except.Trans (ExceptT, runExceptT) import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Data.Either (Either(..)) import Database.PostgreSQL (Connection, fromPool, Pool, Query(Query), PGError)
import Database.PostgreSQL (Connection, Pool, Query(Query), PGError)
import Database.PostgreSQL.PG (command, execute, query, withTransaction) as PG import Database.PostgreSQL.PG (command, execute, query, withTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Pool (new) as Pool
import Database.PostgreSQL.Row (Row0(Row0), Row3(Row3)) 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. `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. 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) Database quering functions like `execute` below can perform the action using the pool
or a connection (js `Client` instance) so they expect a value of type `type Connection = Either Pool Client`. 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 ```purescript
PG.execute (Left pool) (Query """ PG.execute (fromPool pool) (Query """
CREATE TEMPORARY TABLE fruits ( CREATE TEMPORARY TABLE fruits (
name text NOT NULL, name text NOT NULL,
delicious boolean NOT NULL, delicious boolean NOT NULL,
@ -123,7 +123,7 @@ data from db.
`query` function processes db response and returns an `Array` of rows. `query` function processes db response and returns an `Array` of rows.
```purescript ```purescript
names <- PG.query (Left pool) (Query """ names <- PG.query (fromPool pool) (Query """
SELECT name, delicious SELECT name, delicious
FROM fruits FROM fruits
ORDER BY name ASC 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. This function should return `rows` value associated with given response.
```purescript ```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 liftEffect <<< assert $ deleted == 2
``` ```

2
src/Database/PostgreSQL.purs
View File

@ -5,7 +5,7 @@ module Database.PostgreSQL
, module Value , module Value
) where ) 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.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.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 import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value

45
src/Database/PostgreSQL/Aff.purs
View File

@ -1,5 +1,5 @@
module Database.PostgreSQL.Aff module Database.PostgreSQL.Aff
( Connection ( Connection(..)
, PGError(..) , PGError(..)
, PGErrorDetail , PGErrorDetail
, Client , Client
@ -12,11 +12,14 @@ module Database.PostgreSQL.Aff
, withTransaction , withTransaction
, command , command
, execute , execute
, fromClient
, fromPool
, query , query
, scalar , scalar
) where ) where
import Prelude import Prelude
import Control.Monad.Error.Class (catchError, throwError) import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head) import Data.Array (head)
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
@ -74,7 +77,7 @@ withConnection ::
Pool -> Pool ->
(Either PGError Connection -> Aff a) -> (Either PGError Connection -> Aff a) ->
Aff a Aff a
withConnection p k = withClient p (lcmap (map Right) k) withConnection p k = withClient p (lcmap (map fromClient) k)
connect :: connect ::
Pool -> Pool ->
@ -109,7 +112,7 @@ withTransaction pool action =
withClient pool case _ of withClient pool case _ of
Right client -> Right client ->
withClientTransaction client do withClientTransaction client do
(action $ Right client) (action $ fromClient client)
Left err → pure $ Left err Left err → pure $ Left err
-- | TODO: Outdated docs -- | TODO: Outdated docs
@ -139,16 +142,22 @@ withClientTransaction client action =
Nothing -> pure (Right a) Nothing -> pure (Right a)
Just pgError -> pure (Left pgError) Just pgError -> pure (Left pgError)
where 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 newtype Connection = Connection (Either Pool Client)
= 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. -- | APIs of the `Pool.query` and `Client.query` are the same.
-- | We can dse this polyformphis to simplify ffi. -- | We can dse this polyformphis to simplify ffi.
@ -162,7 +171,7 @@ execute ::
Query i o -> Query i o ->
i -> i ->
Aff (Maybe PGError) 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. -- | Execute a PostgreSQL query and return its results.
query :: query ::
@ -173,8 +182,8 @@ query ::
Query i o -> Query i o ->
i -> i ->
Aff (Either PGError (Array o)) Aff (Either PGError (Array o))
query h (Query sql) values = do query conn (Query sql) values = do
r <- unsafeQuery h sql (toSQLRow values) r <- unsafeQuery conn sql (toSQLRow values)
pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError) pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError)
-- | Execute a PostgreSQL query and return the first field of the first row in -- | Execute a PostgreSQL query and return the first field of the first row in
@ -187,7 +196,7 @@ scalar ::
Query i (Row1 o) -> Query i (Row1 o) ->
i -> i ->
Aff (Either PGError (Maybe o)) 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 -- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful -- | (how many rows were affected by the query). This may be useful
@ -199,7 +208,7 @@ command ::
Query i Int -> Query i Int ->
i -> i ->
Aff (Either PGError Int) 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 type QueryResult
= { rows :: Array (Array Foreign) = { rows :: Array (Array Foreign)
@ -211,12 +220,12 @@ unsafeQuery ::
String -> String ->
Array Foreign -> Array Foreign ->
Aff (Either PGError QueryResult) Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s unsafeQuery conn s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler conn) s
where where
toUntaggedHandler ∷ Connection → UntaggedConnection toUntaggedHandler ∷ Connection → UntaggedConnection
toUntaggedHandler (Left pool) = unsafeCoerce pool toUntaggedHandler (Connection c) = case c of
(Left pool) -> unsafeCoerce pool
toUntaggedHandler (Right client) = unsafeCoerce client (Right client) -> unsafeCoerce client
p = p =
{ nullableLeft: toNullable <<< map Left <<< convertError { nullableLeft: toNullable <<< map Left <<< convertError

4
src/Database/PostgreSQL/PG.purs
View File

@ -16,7 +16,7 @@ import Control.Monad.Except (class MonadError)
import Data.Either (Either(..), either) import Data.Either (Either(..), either)
import Data.Maybe (Maybe, maybe) import Data.Maybe (Maybe, maybe)
import Data.Profunctor (lcmap) 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.Aff (command, execute, query, scalar, withClient, withClientTransaction, withTransaction) as Aff
import Database.PostgreSQL.Pool (Pool) import Database.PostgreSQL.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1)
@ -56,7 +56,7 @@ withConnection ::
Pool -> Pool ->
(Connection -> m a) -> (Connection -> m a) ->
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 -- | TODO: Update docs
-- | Run an action within a transaction. The transaction is committed if the -- | Run an action within a transaction. The transaction is committed if the

29
test/Main.purs
View File

@ -3,6 +3,7 @@ module Test.Main
) where ) where
import Prelude import Prelude
import Control.Monad.Error.Class (throwError, try) import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
@ -21,7 +22,7 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) 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 (command, execute, onIntegrityError, query, scalar)
import Database.PostgreSQL.PG (withClient, withClientTransaction) as PG import Database.PostgreSQL.PG (withClient, withClientTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Pool (new) as Pool
@ -57,18 +58,18 @@ withRollback ∷
AppM Unit AppM Unit
withRollback client action = begin *> action *> rollback withRollback client action = begin *> action *> rollback
where 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 ∷ test ∷
Connection → Connection →
String → String →
AppM Unit → AppM Unit →
TestSuite TestSuite
test (Left pool) name action = Test.Unit.test name $ checkPGErrors $ 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
test (Right client) name action = Test.Unit.test name $ checkPGErrors $ withRollback client action
transactionTest ∷ transactionTest ∷
String → String →
@ -111,7 +112,7 @@ main = do
config ← Config.load config ← Config.load
pool ← liftEffect $ Pool.new config pool ← liftEffect $ Pool.new config
checkPGErrors checkPGErrors
$ execute (Left pool) $ execute (fromPool pool)
( Query ( Query
""" """
CREATE TEMPORARY TABLE foods ( CREATE TEMPORARY TABLE foods (
@ -143,7 +144,7 @@ main = do
let let
testCount n = do testCount n = do
count <- count <-
scalar (Left pool) scalar (fromPool pool)
( Query ( Query
""" """
SELECT count(*) = $1 SELECT count(*) = $1
@ -154,7 +155,7 @@ main = do
liftEffect <<< assert $ count == Just true liftEffect <<< assert $ count == Just true
transactionTest "transaction commit" do transactionTest "transaction commit" do
withClientTransaction client do withClientTransaction client do
execute (Right client) execute (fromClient client)
( Query ( Query
""" """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
@ -164,7 +165,7 @@ main = do
(Row3 "pork" true (D.fromString "8.30")) (Row3 "pork" true (D.fromString "8.30"))
testCount 1 testCount 1
testCount 1 testCount 1
execute (Right client) execute (fromClient client)
( Query ( Query
""" """
DELETE FROM foods DELETE FROM foods
@ -176,7 +177,7 @@ main = do
_ <- _ <-
try try
$ withClientTransaction client do $ withClientTransaction client do
execute (Right client) execute (fromClient client)
( Query ( Query
""" """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
@ -186,7 +187,7 @@ main = do
(Row3 "pork" true (D.fromString "8.30")) (Row3 "pork" true (D.fromString "8.30"))
testCount 1 testCount 1
-- invalid SQL query --> PGError is thrown -- 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 -- transaction should've been rolled back
testCount 0 testCount 0
transactionTest "transaction rollback on JavaScript exception" transactionTest "transaction rollback on JavaScript exception"
@ -194,7 +195,7 @@ main = do
result <- result <-
lift $ try $ runExceptT lift $ try $ runExceptT
$ withClientTransaction client do $ withClientTransaction client do
execute (Right client) execute (fromClient client)
( Query ( Query
""" """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
@ -213,7 +214,7 @@ main = do
-- transaction should've been rolled back -- transaction should've been rolled back
testCount 0 testCount 0
let let
handle = Right client handle = fromClient client
test handle "usage of rows represented by nested tuples" test handle "usage of rows represented by nested tuples"
$ do $ do
execute handle execute handle