generated from tpl/purs
Introduce pool based queries. Move Aff API to separate submodule.
This commit is contained in:
parent
4a63d6d7c2
commit
76a5b41f3e
@ -1,5 +1,13 @@
|
||||
# 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 `connect` and `ConnectResult` (@srghma)
|
||||
|
||||
|
83
README.md
83
README.md
@ -19,8 +19,9 @@ module Test.README where
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Except.Trans (ExceptT, runExceptT)
|
||||
import Database.PostgreSQL.PG (defaultConfiguration, PGError, command, execute, Pool, Connection, query, Query(Query))
|
||||
import Database.PostgreSQL.PG as PG
|
||||
import Data.Either (Either(..))
|
||||
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.Row (Row0(Row0), Row3(Row3))
|
||||
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 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
|
||||
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`.
|
||||
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.
|
||||
|
||||
```purescript
|
||||
type PG a = ExceptT PGError Aff a
|
||||
type AppM a = ExceptT PGError Aff a
|
||||
|
||||
withConnection :: forall a. Pool -> (Connection -> PG a) -> PG a
|
||||
withConnection = PG.withConnection runExceptT
|
||||
|
||||
withTransaction :: forall a. Connection -> PG a -> PG a
|
||||
withTransaction = PG.withTransaction runExceptT
|
||||
withTransaction :: forall a. Pool -> (DBHandle -> AppM a) -> AppM a
|
||||
withTransaction p = PG.withTransaction runExceptT p
|
||||
```
|
||||
|
||||
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
|
||||
run ∷ PG Unit
|
||||
run ∷ AppM Unit
|
||||
run = do
|
||||
|
||||
pool <- liftEffect $ Pool.new
|
||||
((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.
|
||||
`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.
|
||||
|
||||
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
|
||||
|
||||
execute conn (Query """
|
||||
CREATE TEMPORARY TABLE fruits (
|
||||
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)
|
||||
);
|
||||
""") Row0
|
||||
PG.execute (Left pool) (Query """
|
||||
CREATE TEMPORARY TABLE fruits (
|
||||
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)
|
||||
);
|
||||
""") 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
|
||||
is thrown during execution of a given `Aff` block. It excecutes `COMMIT`
|
||||
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.
|
||||
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
|
||||
@ -97,11 +98,11 @@ For details please investigate following classes `ToSQLRow`, `ToSQLValue`,
|
||||
`FromSQLRow` and `FromSQLValue`.
|
||||
|
||||
```purescript
|
||||
withTransaction conn $ do
|
||||
execute conn (Query """
|
||||
INSERT INTO fruits (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") (Row3 "coconut" true (Decimal.fromString "8.30"))
|
||||
withTransaction pool \h -> do
|
||||
PG.execute h (Query """
|
||||
INSERT INTO fruits (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") (Row3 "coconut" true (Decimal.fromString "8.30"))
|
||||
```
|
||||
|
||||
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`.
|
||||
|
||||
```purescript
|
||||
execute conn (Query """
|
||||
INSERT INTO fruits (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") ("lemon" /\ false /\ Decimal.fromString "3.30")
|
||||
PG.execute h (Query """
|
||||
INSERT INTO fruits (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") ("lemon" /\ false /\ Decimal.fromString "3.30")
|
||||
```
|
||||
|
||||
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.
|
||||
|
||||
```purescript
|
||||
names <- query conn (Query """
|
||||
SELECT name, delicious
|
||||
FROM fruits
|
||||
ORDER BY name ASC
|
||||
""") Row0
|
||||
liftEffect <<< assert $ names == ["coconut" /\ true, "lemon" /\ false]
|
||||
names <- PG.query (Left pool) (Query """
|
||||
SELECT name, delicious
|
||||
FROM fruits
|
||||
ORDER BY name ASC
|
||||
""") Row0
|
||||
liftEffect <<< assert $ names == ["coconut" /\ true, "lemon" /\ false]
|
||||
```
|
||||
|
||||
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.
|
||||
|
||||
```purescript
|
||||
deleted <- command conn (Query """DELETE FROM fruits """) Row0
|
||||
liftEffect <<< assert $ deleted == 2
|
||||
deleted <- PG.command (Left pool) (Query """DELETE FROM fruits """) Row0
|
||||
liftEffect <<< assert $ deleted == 2
|
||||
```
|
||||
|
||||
## Generating SQL Queries
|
||||
|
@ -1,298 +1,11 @@
|
||||
module Database.PostgreSQL
|
||||
( module Pool
|
||||
( module Aff
|
||||
, module Pool
|
||||
, module Row
|
||||
, module Value
|
||||
, PGError(..)
|
||||
, PGErrorDetail
|
||||
, Connection
|
||||
, ConnectResult
|
||||
, Query(..)
|
||||
, connect
|
||||
, withConnection
|
||||
, 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.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.Aff (Connection, ConnectResult, Query(..), PGError(..), PGErrorDetail) as Aff
|
||||
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(..), 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 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
|
||||
|
@ -43,11 +43,12 @@ exports.ffiConnect = function (config) {
|
||||
};
|
||||
|
||||
exports.ffiUnsafeQuery = function(config) {
|
||||
return function(client) {
|
||||
// Either `Pool` or `Client` instance
|
||||
return function(dbHandle) {
|
||||
return function(sql) {
|
||||
return function(values) {
|
||||
return function(onError, onSuccess) {
|
||||
var q = client.query({
|
||||
var q = dbHandle.query({
|
||||
text: sql,
|
||||
values: values,
|
||||
rowMode: 'array',
|
341
src/Database/PostgreSQL/Aff.purs
Normal file
341
src/Database/PostgreSQL/Aff.purs
Normal 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)
|
@ -1,132 +1,158 @@
|
||||
module Database.PostgreSQL.PG
|
||||
( module Row
|
||||
, module Value
|
||||
, module PostgreSQL
|
||||
, command
|
||||
, execute
|
||||
, query
|
||||
, onIntegrityError
|
||||
, scalar
|
||||
, withConnection
|
||||
, withTransaction
|
||||
) where
|
||||
( command
|
||||
, execute
|
||||
, onIntegrityError
|
||||
, query
|
||||
, scalar
|
||||
, withConnection
|
||||
, withConnectionTransaction
|
||||
, withDBHandle
|
||||
, withTransaction
|
||||
) where
|
||||
|
||||
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.Maybe (Maybe, maybe)
|
||||
import Database.PostgreSQL (Connection, PGError(..), Pool, Query)
|
||||
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 (command, execute, query, scalar, withConnection, withTransaction) as P
|
||||
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 Data.Profunctor (lcmap)
|
||||
import Database.PostgreSQL.Aff (Connection, DBHandle, PGError(..), Query)
|
||||
import Database.PostgreSQL.Aff (command, execute, query, scalar, withConnection, withConnectionTransaction, withTransaction) as Aff
|
||||
import Database.PostgreSQL.Pool (Pool)
|
||||
import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row1)
|
||||
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.Class (class MonadAff, liftAff)
|
||||
|
||||
hoistAffEither :: forall a m. MonadAff m => MonadError PGError m => Aff (Either PGError a) -> m a
|
||||
hoistAffEither m = liftAff m >>= either throwError pure
|
||||
type PG a
|
||||
= 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
|
||||
-- | when the action returns.
|
||||
withConnection
|
||||
:: forall a m
|
||||
. MonadError PGError m
|
||||
=> MonadAff m
|
||||
=> (m a -> Aff (Either PGError a))
|
||||
-> Pool
|
||||
-> (Connection -> m a)
|
||||
-> m a
|
||||
withConnection ::
|
||||
∀ a m.
|
||||
MonadError PGError m =>
|
||||
MonadAff m =>
|
||||
(m a -> Aff (Either PGError a)) ->
|
||||
Pool ->
|
||||
(Connection -> m a) ->
|
||||
m a
|
||||
withConnection f p k = do
|
||||
res <- liftAff $ P.withConnection p case _ of
|
||||
Right conn -> f $ k conn
|
||||
Left pgErr -> pure $ Left pgErr
|
||||
res <-
|
||||
liftAff
|
||||
$ Aff.withConnection p case _ of
|
||||
Right conn -> f $ k conn
|
||||
Left pgErr -> pure $ Left pgErr
|
||||
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
|
||||
-- | action returns cleanly, and rolled back if the action throws (either a
|
||||
-- | `PGError` or a JavaScript exception in PG context). If you want to
|
||||
-- | change the transaction mode, issue a separate `SET TRANSACTION` statement
|
||||
-- | within the transaction.
|
||||
withTransaction
|
||||
:: forall a m
|
||||
. MonadAff m
|
||||
=> MonadError PGError m
|
||||
=> (m a -> Aff (Either PGError a))
|
||||
-> Connection
|
||||
-> m a
|
||||
-> m a
|
||||
withTransaction f conn action = do
|
||||
res <- liftAff $ P.withTransaction conn (f action)
|
||||
withTransaction ::
|
||||
∀ a m.
|
||||
MonadAff m =>
|
||||
MonadError PGError m =>
|
||||
(m a -> Aff (Either PGError a)) ->
|
||||
Pool ->
|
||||
(DBHandle -> m a) ->
|
||||
m a
|
||||
withTransaction f pool action = do
|
||||
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
|
||||
|
||||
-- | Execute a PostgreSQL query and discard its results.
|
||||
execute
|
||||
:: forall i o m
|
||||
. ToSQLRow i
|
||||
=> MonadError PGError m
|
||||
=> MonadAff m
|
||||
=> Connection
|
||||
-> Query i o
|
||||
-> i
|
||||
-> m Unit
|
||||
execute conn sql values = do
|
||||
err <- liftAff $ P.execute conn sql values
|
||||
execute ::
|
||||
∀ i o m.
|
||||
ToSQLRow i =>
|
||||
MonadError PGError m =>
|
||||
MonadAff m =>
|
||||
DBHandle ->
|
||||
Query i o ->
|
||||
i ->
|
||||
m Unit
|
||||
execute h sql values = do
|
||||
err <- liftAff $ Aff.execute h sql values
|
||||
maybe (pure unit) throwError err
|
||||
|
||||
-- | Execute a PostgreSQL query and return its results.
|
||||
query
|
||||
:: forall i o m
|
||||
. ToSQLRow i
|
||||
=> FromSQLRow o
|
||||
=> MonadError PGError m
|
||||
=> MonadAff m
|
||||
=> Connection
|
||||
-> Query i o
|
||||
-> i
|
||||
-> m (Array o)
|
||||
query conn sql = hoistAffEither <<< P.query conn sql
|
||||
query ::
|
||||
∀ i o m.
|
||||
ToSQLRow i =>
|
||||
FromSQLRow o =>
|
||||
MonadError PGError m =>
|
||||
MonadAff m =>
|
||||
DBHandle ->
|
||||
Query i o ->
|
||||
i ->
|
||||
m (Array o)
|
||||
query h sql = hoistPG <<< Aff.query h sql
|
||||
|
||||
-- | Execute a PostgreSQL query and return the first field of the first row in
|
||||
-- | the result.
|
||||
scalar
|
||||
:: forall i o m
|
||||
. ToSQLRow i
|
||||
=> FromSQLValue o
|
||||
=> MonadError PGError m
|
||||
=> MonadAff m
|
||||
=> Connection
|
||||
-> Query i (Row1 o)
|
||||
-> i
|
||||
-> m (Maybe o)
|
||||
scalar conn sql = hoistAffEither <<< P.scalar conn sql
|
||||
scalar ::
|
||||
∀ i o m.
|
||||
ToSQLRow i =>
|
||||
FromSQLValue o =>
|
||||
MonadError PGError m =>
|
||||
MonadAff m =>
|
||||
DBHandle ->
|
||||
Query i (Row1 o) ->
|
||||
i ->
|
||||
m (Maybe o)
|
||||
scalar h sql = hoistPG <<< Aff.scalar h sql
|
||||
|
||||
-- | 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 m
|
||||
. ToSQLRow i
|
||||
=> MonadError PGError m
|
||||
=> MonadAff m
|
||||
=> Connection
|
||||
-> Query i Int
|
||||
-> i
|
||||
-> m Int
|
||||
command conn sql = hoistAffEither <<< P.command conn sql
|
||||
command ::
|
||||
∀ i m.
|
||||
ToSQLRow i =>
|
||||
MonadError PGError m =>
|
||||
MonadAff m =>
|
||||
DBHandle ->
|
||||
Query i Int ->
|
||||
i ->
|
||||
m Int
|
||||
command h sql = hoistPG <<< Aff.command h sql
|
||||
|
||||
onIntegrityError
|
||||
:: forall a m
|
||||
. MonadError PGError m
|
||||
=> m a
|
||||
-> m a
|
||||
-> m a
|
||||
onIntegrityError errorResult db =
|
||||
catchError db handleError
|
||||
where
|
||||
handleError e =
|
||||
case e of
|
||||
IntegrityError _ -> errorResult
|
||||
_ -> throwError e
|
||||
onIntegrityError ::
|
||||
∀ a m.
|
||||
MonadError PGError m =>
|
||||
m a ->
|
||||
m a ->
|
||||
m a
|
||||
onIntegrityError errorResult db = catchError db handleError
|
||||
where
|
||||
handleError e = case e of
|
||||
IntegrityError _ -> errorResult
|
||||
_ -> throwError e
|
||||
|
@ -1,13 +1,12 @@
|
||||
module Test.Config where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (throwError)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Map (fromFoldable) as Map
|
||||
import Data.Newtype (un)
|
||||
import Data.Validation.Semigroup (V(..))
|
||||
import Database.PostgreSQL.PG (Configuration)
|
||||
import Database.PostgreSQL (Configuration)
|
||||
import Dotenv (loadFile) as DotEnv
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
@ -22,26 +21,26 @@ import Polyform.Batteries.Int (validator) as Int
|
||||
import Polyform.Validator (runValidator)
|
||||
import Type.Row (type (+))
|
||||
|
||||
validator
|
||||
∷ ∀ err m
|
||||
. Monad m
|
||||
⇒ Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration
|
||||
validator = { database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
|
||||
<$> Env.required "PG_DB" identity
|
||||
<*> Env.optional "PG_HOST" identity
|
||||
<*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator
|
||||
<*> Env.optional "PG_MAX" Int.validator
|
||||
<*> Env.optional "PG_PASSWORD" identity
|
||||
<*> Env.optional "PG_PORT" Int.validator
|
||||
<*> Env.optional "PG_USER" identity
|
||||
validator ∷
|
||||
∀ err m.
|
||||
Monad m ⇒
|
||||
Env.Validator m (IntExpected + MissingValue + err) Env.Env Configuration
|
||||
validator =
|
||||
{ database: _, host: _, idleTimeoutMillis: _, max: _, password: _, port: _, user: _ }
|
||||
<$> Env.required "PG_DB" identity
|
||||
<*> Env.optional "PG_HOST" identity
|
||||
<*> Env.optional "PG_IDLE_TIMEOUT_MILLISECONDS" Int.validator
|
||||
<*> Env.optional "PG_MAX" Int.validator
|
||||
<*> Env.optional "PG_PASSWORD" identity
|
||||
<*> Env.optional "PG_PORT" Int.validator
|
||||
<*> Env.optional "PG_USER" identity
|
||||
|
||||
load ∷ Aff Configuration
|
||||
load = do
|
||||
void $ DotEnv.loadFile
|
||||
env ← liftEffect $ getEnv <#> (Object.toUnfoldable ∷ _ → Array _) >>> Map.fromFoldable
|
||||
runValidator validator env >>= un V >>> case _ of
|
||||
Left err → do
|
||||
throwError $ error "Configuration error. Please verify your environment and .env file."
|
||||
Right p → pure p
|
||||
|
||||
|
||||
runValidator validator env >>= un V
|
||||
>>> case _ of
|
||||
Left err → do
|
||||
throwError $ error "Configuration error. Please verify your environment and .env file."
|
||||
Right p → pure p
|
||||
|
164
test/Main.purs
164
test/Main.purs
@ -22,8 +22,9 @@ import Data.Maybe (Maybe(..), fromJust)
|
||||
import Data.Newtype (unwrap)
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Database.PostgreSQL (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 (Configuration, Connection, DBHandle, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI)
|
||||
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 Effect (Effect)
|
||||
import Effect.Aff (Aff, error, launchAff)
|
||||
@ -35,49 +36,51 @@ import Math ((%))
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Test.Assert (assert)
|
||||
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 as Test.Unit
|
||||
import Test.Unit.Assert (equal)
|
||||
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
|
||||
withConnection = README.withConnection
|
||||
withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a
|
||||
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
|
||||
|
||||
withRollback
|
||||
∷ Connection
|
||||
→ PG Unit
|
||||
→ PG Unit
|
||||
→ AppM Unit
|
||||
→ AppM Unit
|
||||
withRollback conn action =
|
||||
begin *> action *> rollback
|
||||
where
|
||||
begin = execute conn (Query "BEGIN TRANSACTION") Row0
|
||||
rollback = execute conn (Query "ROLLBACK TRANSACTION") Row0
|
||||
begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0
|
||||
rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0
|
||||
|
||||
test
|
||||
∷ Connection
|
||||
∷ DBHandle
|
||||
→ String
|
||||
→ PG Unit
|
||||
→ AppM Unit
|
||||
→ 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
|
||||
|
||||
transactionTest
|
||||
∷ String
|
||||
→ PG Unit
|
||||
→ AppM Unit
|
||||
→ TestSuite
|
||||
transactionTest name action =
|
||||
Test.Unit.test name $ checkPGErrors $ action
|
||||
|
||||
checkPGErrors :: PG Unit -> Aff Unit
|
||||
checkPGErrors :: AppM Unit -> Aff Unit
|
||||
checkPGErrors action = do
|
||||
runExceptT action >>= case _ of
|
||||
Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError)
|
||||
@ -111,66 +114,68 @@ main = do
|
||||
|
||||
config ← Config.load
|
||||
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
|
||||
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
|
||||
suite "PostgreSQL client" $ do
|
||||
let
|
||||
testCount n = do
|
||||
count <- scalar conn (Query """
|
||||
count <- scalar (Left pool) (Query """
|
||||
SELECT count(*) = $1
|
||||
FROM foods
|
||||
""") (Row1 n)
|
||||
liftEffect <<< assert $ count == Just true
|
||||
|
||||
transactionTest "transaction commit" do
|
||||
withTransaction conn do
|
||||
execute conn (Query """
|
||||
withConnectionTransaction conn do
|
||||
execute (Right conn) (Query """
|
||||
INSERT INTO foods (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") (Row3 "pork" true (D.fromString "8.30"))
|
||||
testCount 1
|
||||
testCount 1
|
||||
execute conn (Query """
|
||||
execute (Right conn) (Query """
|
||||
DELETE FROM foods
|
||||
""") Row0
|
||||
|
||||
transactionTest "transaction rollback on PostgreSQL error" $ do
|
||||
_ <- try $ withTransaction conn do
|
||||
execute conn (Query """
|
||||
_ <- try $ withConnectionTransaction conn do
|
||||
execute (Right conn) (Query """
|
||||
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 conn (Query "foo bar") Row0
|
||||
execute (Right conn) (Query "foo bar") Row0
|
||||
|
||||
-- transaction should've been rolled back
|
||||
testCount 0
|
||||
|
||||
transactionTest "transaction rollback on JavaScript exception" $ do
|
||||
result <- lift $ try $ runExceptT $ withTransaction conn do
|
||||
execute conn (Query """
|
||||
result <- lift $ try $ runExceptT $ withConnectionTransaction conn do
|
||||
execute (Right conn) (Query """
|
||||
INSERT INTO foods (name, delicious, price)
|
||||
VALUES ($1, $2, $3)
|
||||
""") (Row3 "pork" true (D.fromString "8.30"))
|
||||
@ -187,15 +192,18 @@ main = do
|
||||
-- transaction should've been rolled back
|
||||
testCount 0
|
||||
|
||||
test conn "usage of rows represented by nested tuples" $ do
|
||||
execute conn (Query """
|
||||
let
|
||||
handle = Right conn
|
||||
|
||||
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)
|
||||
""")
|
||||
( ("pork" /\ true /\ (D.fromString "8.30"))
|
||||
/\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
|
||||
/\ ("rookworst" /\ true /\ (D.fromString "5.60")))
|
||||
names <- query conn (Query """
|
||||
names <- query handle (Query """
|
||||
SELECT name, delicious
|
||||
FROM foods
|
||||
WHERE delicious
|
||||
@ -203,18 +211,18 @@ main = do
|
||||
""") Row0
|
||||
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
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO dates (date)
|
||||
VALUES ($1)
|
||||
""") row
|
||||
rows <- query conn (Query "SELECT date FROM dates") Row0
|
||||
rows <- query handle (Query "SELECT date FROM dates") Row0
|
||||
liftEffect <<< assert $ rows == [row]
|
||||
|
||||
let
|
||||
insertFood =
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO foods (name, delicious, price)
|
||||
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
|
||||
""") (Row9
|
||||
@ -222,9 +230,9 @@ main = do
|
||||
"sauerkraut" false (D.fromString "3.30")
|
||||
"rookworst" true (D.fromString "5.60"))
|
||||
|
||||
test conn "select column subset" $ do
|
||||
test handle "select column subset" $ do
|
||||
insertFood
|
||||
names <- query conn (Query """
|
||||
names <- query handle (Query """
|
||||
SELECT name, delicious
|
||||
FROM foods
|
||||
WHERE delicious
|
||||
@ -232,27 +240,27 @@ main = do
|
||||
""") Row0
|
||||
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]
|
||||
|
||||
test conn "delete returning columns subset" $ do
|
||||
test handle "delete returning columns subset" $ do
|
||||
insertFood
|
||||
deleted <- query conn (Query """
|
||||
deleted <- query handle (Query """
|
||||
DELETE FROM foods
|
||||
WHERE delicious
|
||||
RETURNING name, delicious
|
||||
""") Row0
|
||||
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
|
||||
deleted <- command conn (Query """
|
||||
deleted <- command handle (Query """
|
||||
DELETE FROM foods
|
||||
WHERE delicious
|
||||
""") Row0
|
||||
liftEffect <<< assert $ deleted == 2
|
||||
|
||||
test conn "handling instant value" $ do
|
||||
test handle "handling instant value" $ do
|
||||
before <- liftEffect $ (unwrap <<< unInstant) <$> now
|
||||
insertFood
|
||||
added <- query conn (Query """
|
||||
added <- query handle (Query """
|
||||
SELECT added
|
||||
FROM foods
|
||||
""") Row0
|
||||
@ -265,9 +273,9 @@ main = do
|
||||
&& after >= (unwrap $ unInstant t))
|
||||
added
|
||||
|
||||
test conn "handling decimal value" $ do
|
||||
test handle "handling decimal value" $ do
|
||||
insertFood
|
||||
sauerkrautPrice <- query conn (Query """
|
||||
sauerkrautPrice <- query handle (Query """
|
||||
SELECT price
|
||||
FROM foods
|
||||
WHERE NOT delicious
|
||||
@ -282,18 +290,18 @@ main = do
|
||||
pure "integrity error was not handled"
|
||||
liftEffect $ assert $ result == "integrity error was handled"
|
||||
|
||||
test conn "handling date value" $ do
|
||||
test handle "handling date value" $ do
|
||||
let
|
||||
d1 = date 2010 2 31
|
||||
d2 = date 2017 2 1
|
||||
d3 = date 2020 6 31
|
||||
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO dates (date)
|
||||
VALUES ($1), ($2), ($3)
|
||||
""") (Row3 d1 d2 d3)
|
||||
|
||||
(dates :: Array (Row1 Date)) <- query conn (Query """
|
||||
(dates :: Array (Row1 Date)) <- query handle (Query """
|
||||
SELECT *
|
||||
FROM dates
|
||||
ORDER BY date ASC
|
||||
@ -301,52 +309,52 @@ main = do
|
||||
pgEqual 3 (length dates)
|
||||
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 expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3]
|
||||
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO jsons (json, jsonb)
|
||||
VALUES ($1, $2)
|
||||
""") (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
|
||||
|
||||
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") ])
|
||||
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO jsons (json, jsonb)
|
||||
VALUES ($1, $2)
|
||||
""") (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
|
||||
|
||||
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") ])]
|
||||
|
||||
execute conn (Query """
|
||||
execute handle (Query """
|
||||
INSERT INTO jsons (json, jsonb)
|
||||
VALUES ($1, $2)
|
||||
""") (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
|
||||
|
||||
test conn "handling jsdate value" $ do
|
||||
test handle "handling jsdate value" $ do
|
||||
let
|
||||
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
|
||||
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)
|
||||
VALUES ($1), ($2), ($3)
|
||||
""") (Row3 jsd1 jsd2 jsd3)
|
||||
|
||||
(timestamps :: Array (Row1 JSDate)) <- query conn (Query """
|
||||
(timestamps :: Array (Row1 JSDate)) <- query handle (Query """
|
||||
SELECT *
|
||||
FROM timestamps
|
||||
ORDER BY timestamp ASC
|
||||
|
Loading…
Reference in New Issue
Block a user