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

Introduce pool based queries. Move Aff API to separate submodule.

Browse Source
This commit is contained in:
Tomasz Rybarczyk 2020-11-10 14:39:30 +01:00
parent 4a63d6d7c2
commit 76a5b41f3e
8 changed files with 624 additions and 527 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -1,5 +1,13 @@
# Changelog # Changelog
## v3.1.0
* Move `Pool` related stuff into dedicated submodule. Rename `newPool` to `Pool.new`. (@paluh)
## v3.0.0
* Encode PG error and expose them as a result value. (@akheron)
## Expose connection pieces (29/02/2020) ## Expose connection pieces (29/02/2020)
* Expose `connect` and `ConnectResult` (@srghma) * Expose `connect` and `ConnectResult` (@srghma)

83
README.md
View File

@ -19,8 +19,9 @@ module Test.README where
import Prelude import Prelude
import Control.Monad.Except.Trans (ExceptT, runExceptT) import Control.Monad.Except.Trans (ExceptT, runExceptT)
import Database.PostgreSQL.PG (defaultConfiguration, PGError, command, execute, Pool, Connection, query, Query(Query)) import Data.Either (Either(..))
import Database.PostgreSQL.PG as PG import Database.PostgreSQL (Connection, DBHandle, defaultConfiguration, Pool, Query(Query), PGError)
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))
import Data.Decimal as Decimal import Data.Decimal as Decimal
@ -34,20 +35,18 @@ import Test.Assert (assert)
The whole API for interaction with PostgreSQL is performed asynchronously in `Aff` The whole API for interaction with PostgreSQL is performed asynchronously in `Aff`
(the only function which runs in plain `Effect` is `Pool.new`). Core library (the only function which runs in plain `Effect` is `Pool.new`). Core library
functions usually results in somthing like `Aff (Either PGError a)` which can be easily functions usually results in somthing like `Aff (Either PGError a)` which can be easily
wrapped by user into `ExceptT` or any other custom monad stack. wrapped by user into `ExceptT` or any other custom monad stack. This base API is exposed by
`PostgreSQL.Aff` module.
To be honest we provide alternatives to functions in the `Database.PostgreSQL.PG` module that work on any stack `m` with `MonadError PGError m` and `MonadAff m`. To be honest we provide alternatives to functions in the `Database.PostgreSQL.PG` module that work on any stack `m` with `MonadError PGError m` and `MonadAff m`.
The module contains two functions `withConnection` and `withTransaction` that require additional parameter - a transformation from a custom monad stack to `Aff (Either PGError a)`. The module contains two functions `withConnection` and `withTransaction` that require additional parameter - a transformation from a custom monad stack to `Aff (Either PGError a)`.
We are going to work with `PG` type in this tutorial but please don't consider it as the only option We are going to work with custom `AppM` type in this tutorial but please don't consider it as the only option
if you encounter any troubles integrating it into your own app monad stack. if you encounter any troubles integrating it into your own app monad stack.
```purescript ```purescript
type PG a = ExceptT PGError Aff a type AppM a = ExceptT PGError Aff a
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a withTransaction :: forall a. Pool -> (DBHandle -> AppM a) -> AppM a
withConnection = PG.withConnection runExceptT withTransaction p = PG.withTransaction runExceptT p
withTransaction :: forall a. Connection -> PG a -> PG a
withTransaction = PG.withTransaction runExceptT
``` ```
We assume here that Postgres is running on a standard local port We assume here that Postgres is running on a standard local port
@ -58,36 +57,38 @@ is run by our test suite and we want to exit after its execution quickly ;-)
```purescript ```purescript
run ∷ PG Unit run ∷ AppM Unit
run = do run = do
pool <- liftEffect $ Pool.new pool <- liftEffect $ Pool.new
((defaultConfiguration "purspg") { idleTimeoutMillis = Just 1000 }) ((defaultConfiguration "purspg") { idleTimeoutMillis = Just 1000 })
withConnection pool \conn -> do
``` ```
We can now create our temporary table which we are going to query in this example. We can now create our temporary table which we are going to query in this example.
`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)
or a connection (js `Client` instance) so they expect a value of type `type DBHandle = Either Pool Connection`.
```purescript ```purescript
execute conn (Query """ PG.execute (Left 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,
price NUMERIC(4,2) NOT NULL, price NUMERIC(4,2) NOT NULL,
added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP, added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP,
PRIMARY KEY (name) PRIMARY KEY (name)
); );
""") Row0 """) Row0
``` ```
There is `withTransaction` helper provided. You can wrap the whole There is a `withTransaction` helper provided. You can wrap the whole
piece of interaction with database in it. It will rollback if any exception piece of interaction with database in it. It will rollback if any exception
is thrown during execution of a given `Aff` block. It excecutes `COMMIT` is thrown during execution of a given `Aff` block. It excecutes `COMMIT`
in the other case. in the other case.
We start our session with insert of some data. It is done by `execute` We start our session with insert of some data. It is done by `PG.execute`
function with `INSERT` statement. function with `INSERT` statement.
Please notice that we are passing a tuple of the arguments to this query Please notice that we are passing a tuple of the arguments to this query
using dedicated constructor. In this case `Row3`. This library provides types using dedicated constructor. In this case `Row3`. This library provides types
@ -97,11 +98,11 @@ For details please investigate following classes `ToSQLRow`, `ToSQLValue`,
`FromSQLRow` and `FromSQLValue`. `FromSQLRow` and `FromSQLValue`.
```purescript ```purescript
withTransaction conn $ do withTransaction pool \h -> do
execute conn (Query """ PG.execute h (Query """
INSERT INTO fruits (name, delicious, price) INSERT INTO fruits (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "coconut" true (Decimal.fromString "8.30")) """) (Row3 "coconut" true (Decimal.fromString "8.30"))
``` ```
We can also use nested tuples instead of `Row*` constructors. This can be a bit more We can also use nested tuples instead of `Row*` constructors. This can be a bit more
@ -109,10 +110,10 @@ verbose but is not restricted to limited and constant number of arguments.
`/\` is just an alias for the `Tuple` constructor from `Data.Tuple.Nested`. `/\` is just an alias for the `Tuple` constructor from `Data.Tuple.Nested`.
```purescript ```purescript
execute conn (Query """ PG.execute h (Query """
INSERT INTO fruits (name, delicious, price) INSERT INTO fruits (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") ("lemon" /\ false /\ Decimal.fromString "3.30") """) ("lemon" /\ false /\ Decimal.fromString "3.30")
``` ```
Of course `Row*` types and nested tuples can be also used when we are fetching Of course `Row*` types and nested tuples can be also used when we are fetching
@ -120,12 +121,12 @@ 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 <- query conn (Query """ names <- PG.query (Left pool) (Query """
SELECT name, delicious SELECT name, delicious
FROM fruits FROM fruits
ORDER BY name ASC ORDER BY name ASC
""") Row0 """) Row0
liftEffect <<< assert $ names == ["coconut" /\ true, "lemon" /\ false] liftEffect <<< assert $ names == ["coconut" /\ true, "lemon" /\ false]
``` ```
There is also a `command` function at our disposal. There is also a `command` function at our disposal.
@ -135,8 +136,8 @@ 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 <- command conn (Query """DELETE FROM fruits """) Row0 deleted <- PG.command (Left pool) (Query """DELETE FROM fruits """) Row0
liftEffect <<< assert $ deleted == 2 liftEffect <<< assert $ deleted == 2
``` ```
## Generating SQL Queries ## Generating SQL Queries

293
src/Database/PostgreSQL.purs
View File

@ -1,298 +1,11 @@
module Database.PostgreSQL module Database.PostgreSQL
( module Pool ( module Aff
, module Pool
, module Row , module Row
, module Value , module Value
, PGError(..)
, PGErrorDetail
, Connection
, ConnectResult
, Query(..)
, connect
, withConnection
, withTransaction
, command
, execute
, query
, scalar
) where ) where
import Prelude import Database.PostgreSQL.Aff (Connection, ConnectResult, Query(..), PGError(..), PGErrorDetail) as Aff
import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head)
import Data.Bifunctor (lmap)
import Data.Either (Either(..), either, hush)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.String (Pattern(..))
import Data.String as String
import Data.Traversable (traverse)
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.Pool (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.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), fromSQLRow, toSQLRow)
import Database.PostgreSQL.Value (class FromSQLValue)
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
import Effect (Effect)
import Effect.Aff (Aff, bracket)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign)
-- | PostgreSQL connection.
foreign import data Connection :: Type
-- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types.
newtype Query i o
= Query String
derive instance newtypeQuery :: Newtype (Query i o) _
-- | Run an action with a connection. The connection is released to the pool
-- | when the action returns.
withConnection ::
forall a.
Pool ->
(Either PGError Connection -> Aff a) ->
Aff a
withConnection p k = bracket (connect p) cleanup run
where
cleanup (Left _) = pure unit
cleanup (Right { done }) = liftEffect done
run (Left err) = k (Left err)
run (Right { connection }) = k (Right connection)
connect ::
Pool ->
Aff (Either PGError ConnectResult)
connect =
fromEffectFnAff
<<< ffiConnect
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
type ConnectResult
= { connection :: Connection
, done :: Effect Unit
}
foreign import ffiConnect ::
forall a.
{ nullableLeft :: Error -> Nullable (Either PGError ConnectResult)
, right :: a -> Either PGError ConnectResult
} ->
Pool ->
EffectFnAff (Either PGError ConnectResult)
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
-- | `PGError` or a JavaScript exception in the Aff context). If you want to
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction.
withTransaction ::
forall a.
Connection ->
Aff a ->
Aff (Either PGError a)
withTransaction conn action =
begin
>>= case _ of
Nothing -> do
a <-
action
`catchError`
\jsErr -> do
void $ rollback
throwError jsErr
commit
>>= case _ of
Just pgError -> pure (Left pgError)
Nothing -> pure (Right a)
Just pgError -> pure (Left pgError)
where
begin = execute conn (Query "BEGIN TRANSACTION") Row0
commit = execute conn (Query "COMMIT TRANSACTION") Row0
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0
-- | Execute a PostgreSQL query and discard its results.
execute ::
forall i o.
(ToSQLRow i) =>
Connection ->
Query i o ->
i ->
Aff (Maybe PGError)
execute conn (Query sql) values = hush <<< either Right Left <$> unsafeQuery conn sql (toSQLRow values)
-- | Execute a PostgreSQL query and return its results.
query ::
forall i o.
ToSQLRow i =>
FromSQLRow o =>
Connection ->
Query i o ->
i ->
Aff (Either PGError (Array o))
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
-- | the result.
scalar ::
forall i o.
ToSQLRow i =>
FromSQLValue o =>
Connection ->
Query i (Row1 o) ->
i ->
Aff (Either PGError (Maybe o))
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
-- | for example with `DELETE` or `UPDATE` queries.
command ::
forall i.
ToSQLRow i =>
Connection ->
Query i Int ->
i ->
Aff (Either PGError Int)
command conn (Query sql) values = map _.rowCount <$> unsafeQuery conn sql (toSQLRow values)
type QueryResult
= { rows :: Array (Array Foreign)
, rowCount :: Int
}
unsafeQuery ::
Connection ->
String ->
Array Foreign ->
Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p c s
where
p =
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
foreign import ffiUnsafeQuery ::
{ nullableLeft :: Error -> Nullable (Either PGError QueryResult)
, right :: QueryResult -> Either PGError QueryResult
} ->
Connection ->
String ->
Array Foreign ->
EffectFnAff (Either PGError QueryResult)
data PGError
= ConnectionError String
| ConversionError String
| InternalError PGErrorDetail
| OperationalError PGErrorDetail
| ProgrammingError PGErrorDetail
| IntegrityError PGErrorDetail
| DataError PGErrorDetail
| NotSupportedError PGErrorDetail
| QueryCanceledError PGErrorDetail
| TransactionRollbackError PGErrorDetail
derive instance eqPGError :: Eq PGError
derive instance genericPGError :: Generic PGError _
instance showPGError :: Show PGError where
show = genericShow
type PGErrorDetail
= { severity :: String
, code :: String
, message :: String
, detail :: String
, hint :: String
, position :: String
, internalPosition :: String
, internalQuery :: String
, where_ :: String
, schema :: String
, table :: String
, column :: String
, dataType :: String
, constraint :: String
, file :: String
, line :: String
, routine :: String
}
foreign import ffiSQLState :: Error -> Nullable String
foreign import ffiErrorDetail :: Error -> PGErrorDetail
convertError :: Error -> Maybe PGError
convertError err = case toMaybe $ ffiSQLState err of
Nothing -> Nothing
Just sqlState -> Just $ convert sqlState $ ffiErrorDetail err
where
convert :: String -> PGErrorDetail -> PGError
convert s =
if prefix "0A" s then
NotSupportedError
else if prefix "20" s || prefix "21" s then
ProgrammingError
else if prefix "22" s then
DataError
else if prefix "23" s then
IntegrityError
else if prefix "24" s || prefix "25" s then
InternalError
else if prefix "26" s || prefix "27" s || prefix "28" s then
OperationalError
else if prefix "2B" s || prefix "2D" s || prefix "2F" s then
InternalError
else if prefix "34" s then
OperationalError
else if prefix "38" s || prefix "39" s || prefix "3B" s then
InternalError
else if prefix "3D" s || prefix "3F" s then
ProgrammingError
else if prefix "40" s then
TransactionRollbackError
else if prefix "42" s || prefix "44" s then
ProgrammingError
else if s == "57014" then
QueryCanceledError
else if prefix "5" s then
OperationalError
else if prefix "F" s then
InternalError
else if prefix "H" s then
OperationalError
else if prefix "P" s then
InternalError
else if prefix "X" s then
InternalError
else
const $ ConnectionError s
prefix :: String -> String -> Boolean
prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p)
-- onIntegrityError :: forall a. PG a -> PG a -> PG a
-- onIntegrityError errorResult db =
-- catchError db handleError
-- where
-- handleError e =
-- case e of
-- IntegrityError _ -> errorResult
-- _ -> throwError e

5
src/Database/PostgreSQL.js → src/Database/PostgreSQL/Aff.js
View File

@ -43,11 +43,12 @@ exports.ffiConnect = function (config) {
}; };
exports.ffiUnsafeQuery = function(config) { exports.ffiUnsafeQuery = function(config) {
return function(client) { // Either `Pool` or `Client` instance
return function(dbHandle) {
return function(sql) { return function(sql) {
return function(values) { return function(values) {
return function(onError, onSuccess) { return function(onError, onSuccess) {
var q = client.query({ var q = dbHandle.query({
text: sql, text: sql,
values: values, values: values,
rowMode: 'array', rowMode: 'array',

341
src/Database/PostgreSQL/Aff.purs Normal file
View File

@ -0,0 +1,341 @@
module Database.PostgreSQL.Aff
( DBHandle
, PGError(..)
, PGErrorDetail
, Connection
, ConnectResult
, Query(..)
, connect
, withConnection
, withConnectionTransaction
, withDBHandle
, withTransaction
, command
, execute
, query
, scalar
) where
import Prelude
import Control.Monad.Error.Class (catchError, throwError)
import Data.Array (head)
import Data.Bifunctor (lmap)
import Data.Either (Either(..), either, hush)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, toMaybe, toNullable)
import Data.Profunctor (lcmap)
import Data.String (Pattern(..))
import Data.String as String
import Data.Traversable (traverse)
import Database.PostgreSQL.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), fromSQLRow, toSQLRow)
import Database.PostgreSQL.Value (class FromSQLValue)
import Effect (Effect)
import Effect.Aff (Aff, bracket)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign)
import Unsafe.Coerce (unsafeCoerce)
-- | PostgreSQL connection.
foreign import data Connection :: Type
-- | PostgreSQL query with parameter (`$1`, `$2`, …) and return types.
newtype Query i o
= Query String
derive instance newtypeQuery :: Newtype (Query i o) _
-- | Run an action with a connection. The connection is released to the pool
-- | when the action returns.
withConnection ::
forall a.
Pool ->
(Either PGError Connection -> Aff a) ->
Aff a
withConnection p k = bracket (connect p) cleanup run
where
cleanup (Left _) = pure unit
cleanup (Right { done }) = liftEffect done
run (Left err) = k (Left err)
run (Right { connection }) = k (Right connection)
-- | Trivial helper / shortcut which also wraps
-- | the connection to provide `DBHandle`.
withDBHandle ::
forall a.
Pool ->
(Either PGError DBHandle -> Aff a) ->
Aff a
withDBHandle p k = withConnection p (lcmap (map Right) k)
connect ::
Pool ->
Aff (Either PGError ConnectResult)
connect =
fromEffectFnAff
<<< ffiConnect
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
type ConnectResult
= { connection :: Connection
, done :: Effect Unit
}
foreign import ffiConnect ::
forall a.
{ nullableLeft :: Error -> Nullable (Either PGError ConnectResult)
, right :: a -> Either PGError ConnectResult
} ->
Pool ->
EffectFnAff (Either PGError ConnectResult)
-- | TODO: Provide docs
withTransaction ::
forall a.
Pool ->
(DBHandle -> Aff a) ->
Aff (Either PGError a)
withTransaction pool action =
withConnection pool case _ of
Right conn -> withConnectionTransaction conn do
(action $ Right conn)
Left err → pure $ Left err
-- | TODO: Outdated docs
-- | Run an action within a transaction. The transaction is committed if the
-- | action returns cleanly, and rolled back if the action throws (either a
-- | `PGError` or a JavaScript exception in the Aff context). If you want to
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction.
withConnectionTransaction ::
forall a.
Connection ->
Aff a ->
Aff (Either PGError a)
withConnectionTransaction conn action =
begin
>>= case _ of
Nothing -> do
a <-
action
`catchError`
\jsErr -> do
void $ rollback
throwError jsErr
commit
>>= case _ of
Just pgError -> pure (Left pgError)
Nothing -> pure (Right a)
Just pgError -> pure (Left pgError)
where
h = Right conn
begin = execute h (Query "BEGIN TRANSACTION") Row0
commit = execute h (Query "COMMIT TRANSACTION") Row0
rollback = execute h (Query "ROLLBACK TRANSACTION") Row0
type DBHandle
= Either Pool Connection
-- | APIs of the `Pool.query` and `Client.query` are the same.
-- | We can dse this polyformphis to simplify ffi.
foreign import data UntaggedDBHandle ∷ Type
-- | Execute a PostgreSQL query and discard its results.
execute ::
forall i o.
(ToSQLRow i) =>
DBHandle ->
Query i o ->
i ->
Aff (Maybe PGError)
execute h (Query sql) values = hush <<< either Right Left <$> unsafeQuery h sql (toSQLRow values)
-- | Execute a PostgreSQL query and return its results.
query ::
forall i o.
ToSQLRow i =>
FromSQLRow o =>
DBHandle ->
Query i o ->
i ->
Aff (Either PGError (Array o))
query h (Query sql) values = do
r <- unsafeQuery h sql (toSQLRow values)
pure $ r >>= _.rows >>> traverse (fromSQLRow >>> lmap ConversionError)
-- | Execute a PostgreSQL query and return the first field of the first row in
-- | the result.
scalar ::
forall i o.
ToSQLRow i =>
FromSQLValue o =>
DBHandle ->
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))
-- | Execute a PostgreSQL query and return its command tag value
-- | (how many rows were affected by the query). This may be useful
-- | for example with `DELETE` or `UPDATE` queries.
command ::
forall i.
ToSQLRow i =>
DBHandle ->
Query i Int ->
i ->
Aff (Either PGError Int)
command h (Query sql) values = map _.rowCount <$> unsafeQuery h sql (toSQLRow values)
type QueryResult
= { rows :: Array (Array Foreign)
, rowCount :: Int
}
unsafeQuery ::
DBHandle ->
String ->
Array Foreign ->
Aff (Either PGError QueryResult)
unsafeQuery c s = fromEffectFnAff <<< ffiUnsafeQuery p (toUntaggedHandler c) s
where
toUntaggedHandler ∷ DBHandle → UntaggedDBHandle
toUntaggedHandler (Left pool) = unsafeCoerce pool
toUntaggedHandler (Right conn) = unsafeCoerce conn
p =
{ nullableLeft: toNullable <<< map Left <<< convertError
, right: Right
}
foreign import ffiUnsafeQuery ::
{ nullableLeft :: Error -> Nullable (Either PGError QueryResult)
, right :: QueryResult -> Either PGError QueryResult
} ->
UntaggedDBHandle ->
String ->
Array Foreign ->
EffectFnAff (Either PGError QueryResult)
data PGError
= ConnectionError String
| ConversionError String
| InternalError PGErrorDetail
| OperationalError PGErrorDetail
| ProgrammingError PGErrorDetail
| IntegrityError PGErrorDetail
| DataError PGErrorDetail
| NotSupportedError PGErrorDetail
| QueryCanceledError PGErrorDetail
| TransactionRollbackError PGErrorDetail
derive instance eqPGError :: Eq PGError
derive instance genericPGError :: Generic PGError _
instance showPGError :: Show PGError where
show = genericShow
type PGErrorDetail
= { severity :: String
, code :: String
, message :: String
, detail :: String
, hint :: String
, position :: String
, internalPosition :: String
, internalQuery :: String
, where_ :: String
, schema :: String
, table :: String
, column :: String
, dataType :: String
, constraint :: String
, file :: String
, line :: String
, routine :: String
}
foreign import ffiSQLState :: Error -> Nullable String
foreign import ffiErrorDetail :: Error -> PGErrorDetail
convertError :: Error -> Maybe PGError
convertError err = case toMaybe $ ffiSQLState err of
Nothing -> Nothing
Just sqlState -> Just $ convert sqlState $ ffiErrorDetail err
where
convert :: String -> PGErrorDetail -> PGError
convert s =
if prefix "0A" s then
NotSupportedError
else
if prefix "20" s || prefix "21" s then
ProgrammingError
else
if prefix "22" s then
DataError
else
if prefix "23" s then
IntegrityError
else
if prefix "24" s || prefix "25" s then
InternalError
else
if prefix "26" s || prefix "27" s || prefix "28" s then
OperationalError
else
if prefix "2B" s || prefix "2D" s || prefix "2F" s then
InternalError
else
if prefix "34" s then
OperationalError
else
if prefix "38" s || prefix "39" s || prefix "3B" s then
InternalError
else
if prefix "3D" s || prefix "3F" s then
ProgrammingError
else
if prefix "40" s then
TransactionRollbackError
else
if prefix "42" s || prefix "44" s then
ProgrammingError
else
if s == "57014" then
QueryCanceledError
else
if prefix "5" s then
OperationalError
else
if prefix "F" s then
InternalError
else
if prefix "H" s then
OperationalError
else
if prefix "P" s then
InternalError
else
if prefix "X" s then
InternalError
else
const $ ConnectionError s
prefix :: String -> String -> Boolean
prefix p = maybe false (_ == 0) <<< String.indexOf (Pattern p)

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

@ -1,132 +1,158 @@
module Database.PostgreSQL.PG module Database.PostgreSQL.PG
( module Row ( command
, module Value , execute
, module PostgreSQL , onIntegrityError
, command , query
, execute , scalar
, query , withConnection
, onIntegrityError , withConnectionTransaction
, scalar , withDBHandle
, withConnection , withTransaction
, withTransaction ) where
) where
import Prelude import Prelude
import Control.Monad.Error.Class (class MonadError, catchError, throwError) import Control.Monad.Error.Class (catchError, throwError)
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 Database.PostgreSQL (Connection, PGError(..), Pool, Query) import Data.Profunctor (lcmap)
import Database.PostgreSQL (class FromSQLRow, class FromSQLValue, class ToSQLRow, class ToSQLValue, Connection, Database, PGError(..), PGErrorDetail, Pool, Configuration, Query(..), Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), defaultConfiguration, fromSQLRow, fromSQLValue, instantFromString, instantToString, new, null, toSQLRow, toSQLValue, unsafeIsBuffer) as PostgreSQL import Database.PostgreSQL.Aff (Connection, DBHandle, PGError(..), Query)
import Database.PostgreSQL (command, execute, query, scalar, withConnection, withTransaction) as P import Database.PostgreSQL.Aff (command, execute, query, scalar, withConnection, withConnectionTransaction, withTransaction) as Aff
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.Pool (Pool)
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1) import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1)
import Database.PostgreSQL.Value (class FromSQLValue) import Database.PostgreSQL.Value (class FromSQLValue)
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, instantFromString, instantToString, null, toSQLValue, unsafeIsBuffer) as Value
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Aff.Class (class MonadAff, liftAff)
hoistAffEither :: forall a m. MonadAff m => MonadError PGError m => Aff (Either PGError a) -> m a type PG a
hoistAffEither m = liftAff m >>= either throwError pure = Aff (Either PGError a)
hoistPG :: ∀ a m. MonadAff m => MonadError PGError m => PG a -> m a
hoistPG m = liftAff m >>= either throwError pure
-- | Run an action with a connection. The connection is released to the pool -- | Run an action with a connection. The connection is released to the pool
-- | when the action returns. -- | when the action returns.
withConnection withConnection ::
:: forall a m ∀ a m.
. MonadError PGError m MonadError PGError m =>
=> MonadAff m MonadAff m =>
=> (m a -> Aff (Either PGError a)) (m a -> Aff (Either PGError a)) ->
-> Pool Pool ->
-> (Connection -> m a) (Connection -> m a) ->
-> m a m a
withConnection f p k = do withConnection f p k = do
res <- liftAff $ P.withConnection p case _ of res <-
Right conn -> f $ k conn liftAff
Left pgErr -> pure $ Left pgErr $ Aff.withConnection p case _ of
Right conn -> f $ k conn
Left pgErr -> pure $ Left pgErr
either throwError pure res either throwError pure res
withDBHandle ::
∀ a m.
MonadError PGError m =>
MonadAff m =>
(m a -> Aff (Either PGError a)) ->
Pool ->
(DBHandle -> m a) ->
m a
withDBHandle f p k = withConnection f p (lcmap Right k)
-- | 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
-- | action returns cleanly, and rolled back if the action throws (either a -- | action returns cleanly, and rolled back if the action throws (either a
-- | `PGError` or a JavaScript exception in PG context). If you want to -- | `PGError` or a JavaScript exception in PG context). If you want to
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement -- | change the transaction mode, issue a separate `SET TRANSACTION` statement
-- | within the transaction. -- | within the transaction.
withTransaction withTransaction ::
:: forall a m ∀ a m.
. MonadAff m MonadAff m =>
=> MonadError PGError m MonadError PGError m =>
=> (m a -> Aff (Either PGError a)) (m a -> Aff (Either PGError a)) ->
-> Connection Pool ->
-> m a (DBHandle -> m a) ->
-> m a m a
withTransaction f conn action = do withTransaction f pool action = do
res <- liftAff $ P.withTransaction conn (f action) res <- liftAff $ Aff.withTransaction pool \conn -> do
(f (action conn))
either throwError pure $ join res
withConnectionTransaction ::
∀ a m.
MonadAff m =>
MonadError PGError m =>
(m a -> Aff (Either PGError a)) ->
Connection ->
m a ->
m a
withConnectionTransaction f conn action = do
res <- liftAff $ Aff.withConnectionTransaction conn (f action)
either throwError pure $ join res either throwError pure $ join res
-- | Execute a PostgreSQL query and discard its results. -- | Execute a PostgreSQL query and discard its results.
execute execute ::
:: forall i o m ∀ i o m.
. ToSQLRow i ToSQLRow i =>
=> MonadError PGError m MonadError PGError m =>
=> MonadAff m MonadAff m =>
=> Connection DBHandle ->
-> Query i o Query i o ->
-> i i ->
-> m Unit m Unit
execute conn sql values = do execute h sql values = do
err <- liftAff $ P.execute conn sql values err <- liftAff $ Aff.execute h sql values
maybe (pure unit) throwError err maybe (pure unit) throwError err
-- | Execute a PostgreSQL query and return its results. -- | Execute a PostgreSQL query and return its results.
query query ::
:: forall i o m ∀ i o m.
. ToSQLRow i ToSQLRow i =>
=> FromSQLRow o FromSQLRow o =>
=> MonadError PGError m MonadError PGError m =>
=> MonadAff m MonadAff m =>
=> Connection DBHandle ->
-> Query i o Query i o ->
-> i i ->
-> m (Array o) m (Array o)
query conn sql = hoistAffEither <<< P.query conn sql query h sql = hoistPG <<< Aff.query h sql
-- | 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
-- | the result. -- | the result.
scalar scalar ::
:: forall i o m ∀ i o m.
. ToSQLRow i ToSQLRow i =>
=> FromSQLValue o FromSQLValue o =>
=> MonadError PGError m MonadError PGError m =>
=> MonadAff m MonadAff m =>
=> Connection DBHandle ->
-> Query i (Row1 o) Query i (Row1 o) ->
-> i i ->
-> m (Maybe o) m (Maybe o)
scalar conn sql = hoistAffEither <<< P.scalar conn sql scalar h sql = hoistPG <<< Aff.scalar h sql
-- | 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
-- | for example with `DELETE` or `UPDATE` queries. -- | for example with `DELETE` or `UPDATE` queries.
command command ::
:: forall i m ∀ i m.
. ToSQLRow i ToSQLRow i =>
=> MonadError PGError m MonadError PGError m =>
=> MonadAff m MonadAff m =>
=> Connection DBHandle ->
-> Query i Int Query i Int ->
-> i i ->
-> m Int m Int
command conn sql = hoistAffEither <<< P.command conn sql command h sql = hoistPG <<< Aff.command h sql
onIntegrityError onIntegrityError ::
:: forall a m ∀ a m.
. MonadError PGError m MonadError PGError m =>
=> m a m a ->
-> m a m a ->
-> m a m a
onIntegrityError errorResult db = onIntegrityError errorResult db = catchError db handleError
catchError db handleError where
where handleError e = case e of
handleError e = IntegrityError _ -> errorResult
case e of _ -> throwError e
IntegrityError _ -> errorResult
_ -> throwError e

39
test/Config.purs
View File

@ -1,13 +1,12 @@
module Test.Config where module Test.Config where
import Prelude import Prelude
import Control.Monad.Error.Class (throwError) import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Map (fromFoldable) as Map import Data.Map (fromFoldable) as Map
import Data.Newtype (un) import Data.Newtype (un)
import Data.Validation.Semigroup (V(..)) import Data.Validation.Semigroup (V(..))
import Database.PostgreSQL.PG (Configuration) import Database.PostgreSQL (Configuration)
import Dotenv (loadFile) as DotEnv import Dotenv (loadFile) as DotEnv
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
@ -22,26 +21,26 @@ import Polyform.Batteries.Int (validator) as Int
import Polyform.Validator (runValidator) import Polyform.Validator (runValidator)
import Type.Row (type (+)) import Type.Row (type (+))
validator validator ∷
∷ ∀ err m ∀ err m.
. Monad m Monad m ⇒
⇒ Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration
validator = { database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ } validator =
<$> Env.required "PG_DB" identity { database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
<*> Env.optional "PG_HOST" identity <$> Env.required "PG_DB" identity
<*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator <*> Env.optional "PG_HOST" identity
<*> Env.optional "PG_MAX" Int.validator <*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator
<*> Env.optional "PG_PASSWORD" identity <*> Env.optional "PG_MAX" Int.validator
<*> Env.optional "PG_PORT" Int.validator <*> Env.optional "PG_PASSWORD" identity
<*> Env.optional "PG_USER" identity <*> Env.optional "PG_PORT" Int.validator
<*> Env.optional "PG_USER" identity
load ∷ Aff Configuration load ∷ Aff Configuration
load = do load = do
void $ DotEnv.loadFile void $ DotEnv.loadFile
env ← liftEffect $ getEnv <#> (Object.toUnfoldable ∷ _ → Array _) >>> Map.fromFoldable env ← liftEffect $ getEnv <#> (Object.toUnfoldable ∷ _ → Array _) >>> Map.fromFoldable
runValidator validator env >>= un V >>> case _ of runValidator validator env >>= un V
Left err → do >>> case _ of
throwError $ error "Configuration error. Please verify your environment and .env file." Left err → do
Right p → pure p throwError $ error "Configuration error. Please verify your environment and .env file."
Right p → pure p

164
test/Main.purs
View File

@ -22,8 +22,9 @@ 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 (PGConnectionURI, parseURI) import Database.PostgreSQL (Configuration, Connection, DBHandle, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI)
import Database.PostgreSQL.PG (Configuration, Connection, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, onIntegrityError, query, scalar) import Database.PostgreSQL.PG (command, execute, onIntegrityError, query, scalar)
import Database.PostgreSQL.PG (withConnection, withConnectionTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool import Database.PostgreSQL.Pool (new) as Pool
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, error, launchAff) import Effect.Aff (Aff, error, launchAff)
@ -35,49 +36,51 @@ import Math ((%))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Test.Assert (assert) import Test.Assert (assert)
import Test.Config (load) as Config import Test.Config (load) as Config
import Test.README (run, PG, withConnection, withTransaction) as README import Test.README (AppM)
import Test.README (run) as README
import Test.Unit (TestSuite, suite) import Test.Unit (TestSuite, suite)
import Test.Unit as Test.Unit import Test.Unit as Test.Unit
import Test.Unit.Assert (equal) import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest) import Test.Unit.Main (runTest)
type PG a = README.PG a withConnection :: forall a. Pool -> (Connection -> AppM a) -> AppM a
withConnection = PG.withConnection runExceptT
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a
withConnection = README.withConnection withConnectionTransaction = PG.withConnectionTransaction runExceptT
withTransaction :: forall a. Connection -> PG a -> PG a
withTransaction = README.withTransaction
pgEqual :: forall a. Eq a => Show a => a -> a -> PG Unit pgEqual :: forall a. Eq a => Show a => a -> a -> AppM Unit
pgEqual a b = lift $ equal a b pgEqual a b = lift $ equal a b
withRollback withRollback
∷ Connection ∷ Connection
→ PG Unit → AppM Unit
→ PG Unit → AppM Unit
withRollback conn action = withRollback conn action =
begin *> action *> rollback begin *> action *> rollback
where where
begin = execute conn (Query "BEGIN TRANSACTION") Row0 begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0 rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0
test test
∷ Connection ∷ DBHandle
→ String → String
→ PG Unit → AppM Unit
→ TestSuite → TestSuite
test conn name action = test (Left pool) name action =
Test.Unit.test name $ checkPGErrors $ action
test (Right conn) name action =
Test.Unit.test name $ checkPGErrors $ withRollback conn action Test.Unit.test name $ checkPGErrors $ withRollback conn action
transactionTest transactionTest
∷ String ∷ String
→ PG Unit → AppM Unit
→ TestSuite → TestSuite
transactionTest name action = transactionTest name action =
Test.Unit.test name $ checkPGErrors $ action Test.Unit.test name $ checkPGErrors $ action
checkPGErrors :: PG Unit -> Aff Unit checkPGErrors :: AppM Unit -> Aff Unit
checkPGErrors action = do checkPGErrors action = do
runExceptT action >>= case _ of runExceptT action >>= case _ of
Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError) Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError)
@ -111,66 +114,68 @@ main = do
config ← Config.load config ← Config.load
pool ← liftEffect $ Pool.new config pool ← liftEffect $ Pool.new config
checkPGErrors $ execute (Left 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
);
""") Row0
checkPGErrors $ withConnection pool \conn -> do checkPGErrors $ withConnection pool \conn -> do
execute conn (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
);
""") Row0
liftEffect $ runTest $ do liftEffect $ runTest $ do
suite "PostgreSQL client" $ do suite "PostgreSQL client" $ do
let let
testCount n = do testCount n = do
count <- scalar conn (Query """ count <- scalar (Left pool) (Query """
SELECT count(*) = $1 SELECT count(*) = $1
FROM foods FROM foods
""") (Row1 n) """) (Row1 n)
liftEffect <<< assert $ count == Just true liftEffect <<< assert $ count == Just true
transactionTest "transaction commit" do transactionTest "transaction commit" do
withTransaction conn do withConnectionTransaction conn do
execute conn (Query """ execute (Right conn) (Query """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30")) """) (Row3 "pork" true (D.fromString "8.30"))
testCount 1 testCount 1
testCount 1 testCount 1
execute conn (Query """ execute (Right conn) (Query """
DELETE FROM foods DELETE FROM foods
""") Row0 """) Row0
transactionTest "transaction rollback on PostgreSQL error" $ do transactionTest "transaction rollback on PostgreSQL error" $ do
_ <- try $ withTransaction conn do _ <- try $ withConnectionTransaction conn do
execute conn (Query """ execute (Right conn) (Query """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (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 conn (Query "foo bar") Row0 execute (Right conn) (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" $ do transactionTest "transaction rollback on JavaScript exception" $ do
result <- lift $ try $ runExceptT $ withTransaction conn do result <- lift $ try $ runExceptT $ withConnectionTransaction conn do
execute conn (Query """ execute (Right conn) (Query """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3) VALUES ($1, $2, $3)
""") (Row3 "pork" true (D.fromString "8.30")) """) (Row3 "pork" true (D.fromString "8.30"))
@ -187,15 +192,18 @@ main = do
-- transaction should've been rolled back -- transaction should've been rolled back
testCount 0 testCount 0
test conn "usage of rows represented by nested tuples" $ do let
execute conn (Query """ handle = Right conn
test handle "usage of rows represented by nested tuples" $ do
execute handle (Query """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
""") """)
( ("pork" /\ true /\ (D.fromString "8.30")) ( ("pork" /\ true /\ (D.fromString "8.30"))
/\ ("sauerkraut" /\ false /\ (D.fromString "3.30")) /\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
/\ ("rookworst" /\ true /\ (D.fromString "5.60"))) /\ ("rookworst" /\ true /\ (D.fromString "5.60")))
names <- query conn (Query """ names <- query handle (Query """
SELECT name, delicious SELECT name, delicious
FROM foods FROM foods
WHERE delicious WHERE delicious
@ -203,18 +211,18 @@ main = do
""") Row0 """) Row0
liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true] liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true]
test conn "nested tuples as rows - just one element" $ do test handle "nested tuples as rows - just one element" $ do
let row = date 2010 2 31 /\ unit let row = date 2010 2 31 /\ unit
execute conn (Query """ execute handle (Query """
INSERT INTO dates (date) INSERT INTO dates (date)
VALUES ($1) VALUES ($1)
""") row """) row
rows <- query conn (Query "SELECT date FROM dates") Row0 rows <- query handle (Query "SELECT date FROM dates") Row0
liftEffect <<< assert $ rows == [row] liftEffect <<< assert $ rows == [row]
let let
insertFood = insertFood =
execute conn (Query """ execute handle (Query """
INSERT INTO foods (name, delicious, price) INSERT INTO foods (name, delicious, price)
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9) VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
""") (Row9 """) (Row9
@ -222,9 +230,9 @@ main = do
"sauerkraut" false (D.fromString "3.30") "sauerkraut" false (D.fromString "3.30")
"rookworst" true (D.fromString "5.60")) "rookworst" true (D.fromString "5.60"))
test conn "select column subset" $ do test handle "select column subset" $ do
insertFood insertFood
names <- query conn (Query """ names <- query handle (Query """
SELECT name, delicious SELECT name, delicious
FROM foods FROM foods
WHERE delicious WHERE delicious
@ -232,27 +240,27 @@ main = do
""") Row0 """) Row0
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true] liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]
test conn "delete returning columns subset" $ do test handle "delete returning columns subset" $ do
insertFood insertFood
deleted <- query conn (Query """ deleted <- query handle (Query """
DELETE FROM foods DELETE FROM foods
WHERE delicious WHERE delicious
RETURNING name, delicious RETURNING name, delicious
""") Row0 """) Row0
liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true] liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true]
test conn "delete returning command tag value" $ do test handle "delete returning command tag value" $ do
insertFood insertFood
deleted <- command conn (Query """ deleted <- command handle (Query """
DELETE FROM foods DELETE FROM foods
WHERE delicious WHERE delicious
""") Row0 """) Row0
liftEffect <<< assert $ deleted == 2 liftEffect <<< assert $ deleted == 2
test conn "handling instant value" $ do test handle "handling instant value" $ do
before <- liftEffect $ (unwrap <<< unInstant) <$> now before <- liftEffect $ (unwrap <<< unInstant) <$> now
insertFood insertFood
added <- query conn (Query """ added <- query handle (Query """
SELECT added SELECT added
FROM foods FROM foods
""") Row0 """) Row0
@ -265,9 +273,9 @@ main = do
&& after >= (unwrap $ unInstant t)) && after >= (unwrap $ unInstant t))
added added
test conn "handling decimal value" $ do test handle "handling decimal value" $ do
insertFood insertFood
sauerkrautPrice <- query conn (Query """ sauerkrautPrice <- query handle (Query """
SELECT price SELECT price
FROM foods FROM foods
WHERE NOT delicious WHERE NOT delicious
@ -282,18 +290,18 @@ main = do
pure "integrity error was not handled" pure "integrity error was not handled"
liftEffect $ assert $ result == "integrity error was handled" liftEffect $ assert $ result == "integrity error was handled"
test conn "handling date value" $ do test handle "handling date value" $ do
let let
d1 = date 2010 2 31 d1 = date 2010 2 31
d2 = date 2017 2 1 d2 = date 2017 2 1
d3 = date 2020 6 31 d3 = date 2020 6 31
execute conn (Query """ execute handle (Query """
INSERT INTO dates (date) INSERT INTO dates (date)
VALUES ($1), ($2), ($3) VALUES ($1), ($2), ($3)
""") (Row3 d1 d2 d3) """) (Row3 d1 d2 d3)
(dates :: Array (Row1 Date)) <- query conn (Query """ (dates :: Array (Row1 Date)) <- query handle (Query """
SELECT * SELECT *
FROM dates FROM dates
ORDER BY date ASC ORDER BY date ASC
@ -301,52 +309,52 @@ main = do
pgEqual 3 (length dates) pgEqual 3 (length dates)
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
test conn "handling Foreign.Object as json and jsonb" $ do test handle "handling Foreign.Object as json and jsonb" $ do
let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3] let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3]
execute conn (Query """ execute handle (Query """
INSERT INTO jsons (json, jsonb) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) VALUES ($1, $2)
""") (Row2 jsonIn jsonIn) """) (Row2 jsonIn jsonIn)
(js ∷ Array (Row2 (Object Int) (Object Int))) <- query conn (Query """SELECT * FROM JSONS""") Row0 (js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js
test conn "handling Argonaut.Json as json and jsonb for an object" $ do test handle "handling Argonaut.Json as json and jsonb for an object" $ do
let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])
execute conn (Query """ execute handle (Query """
INSERT INTO jsons (json, jsonb) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) VALUES ($1, $2)
""") (Row2 input input) """) (Row2 input input)
(js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0 (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
test conn "handling Argonaut.Json as json and jsonb for an array" $ do test handle "handling Argonaut.Json as json and jsonb for an array" $ do
let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])] let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])]
execute conn (Query """ execute handle (Query """
INSERT INTO jsons (json, jsonb) INSERT INTO jsons (json, jsonb)
VALUES ($1, $2) VALUES ($1, $2)
""") (Row2 input input) """) (Row2 input input)
(js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0 (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js
test conn "handling jsdate value" $ do test handle "handling jsdate value" $ do
let let
jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0 jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0
jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0 jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0
jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0 jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0
execute conn (Query """ execute handle (Query """
INSERT INTO timestamps (timestamp) INSERT INTO timestamps (timestamp)
VALUES ($1), ($2), ($3) VALUES ($1), ($2), ($3)
""") (Row3 jsd1 jsd2 jsd3) """) (Row3 jsd1 jsd2 jsd3)
(timestamps :: Array (Row1 JSDate)) <- query conn (Query """ (timestamps :: Array (Row1 JSDate)) <- query handle (Query """
SELECT * SELECT *
FROM timestamps FROM timestamps
ORDER BY timestamp ASC ORDER BY timestamp ASC