generated from tpl/purs
Allow nested tuples to be used as query rows
This commit is contained in:
Tomasz Rybarczyk
parent
c0ac46c00a
commit
8683419e85
@ -1,11 +1,14 @@
|
|||||||
module Database.PostgreSQL.Row where
|
module Database.PostgreSQL.Row where
|
||||||
|
|
||||||
import Data.Array as Array
|
|
||||||
import Data.Either (Either(..))
|
|
||||||
import Foreign (Foreign)
|
|
||||||
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, toSQLValue)
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
|
import Data.Array (uncons, (:))
|
||||||
|
import Data.Array as Array
|
||||||
|
import Data.Either (Either(..), note)
|
||||||
|
import Data.Tuple (Tuple(..))
|
||||||
|
import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, toSQLValue)
|
||||||
|
import Foreign (Foreign)
|
||||||
|
|
||||||
-- | Convert things to SQL rows.
|
-- | Convert things to SQL rows.
|
||||||
class ToSQLRow a where
|
class ToSQLRow a where
|
||||||
toSQLRow :: a -> Array Foreign
|
toSQLRow :: a -> Array Foreign
|
||||||
@ -17,6 +20,19 @@ class FromSQLRow a where
|
|||||||
instance toSQLRowForeignArray :: ToSQLRow (Array Foreign) where
|
instance toSQLRowForeignArray :: ToSQLRow (Array Foreign) where
|
||||||
toSQLRow = identity
|
toSQLRow = identity
|
||||||
|
|
||||||
|
instance toSQLRowTuple :: (ToSQLValue a, ToSQLRow (Tuple b t)) => ToSQLRow (Tuple a (Tuple b t)) where
|
||||||
|
toSQLRow (Tuple a t) = toSQLValue a : toSQLRow t
|
||||||
|
else instance toSQLRowTupleEnd :: (ToSQLValue a, ToSQLValue b) => ToSQLRow (Tuple a b) where
|
||||||
|
toSQLRow (Tuple a b) = [ toSQLValue a, toSQLValue b ]
|
||||||
|
|
||||||
|
instance fromSQLRowTuple :: (FromSQLValue a, FromSQLRow (Tuple b t)) => FromSQLRow (Tuple a (Tuple b t)) where
|
||||||
|
fromSQLRow r = do
|
||||||
|
{head, tail} ← note "Expecting more fields in a row" $ uncons r
|
||||||
|
Tuple <$> fromSQLValue head <*> fromSQLRow tail
|
||||||
|
else instance fromSQLRowTupleEnd :: (FromSQLValue a, FromSQLValue b) => FromSQLRow (Tuple a b) where
|
||||||
|
fromSQLRow [a, b] = Tuple <$> fromSQLValue a <*> fromSQLValue b
|
||||||
|
fromSQLRow _ = Left "Expecting exactly two more fields."
|
||||||
|
|
||||||
-- | A row with 0 fields.
|
-- | A row with 0 fields.
|
||||||
data Row0 = Row0
|
data Row0 = Row0
|
||||||
|
|
||||||
|
|||||||
348
test/Main.purs
348
test/Main.purs
@ -18,6 +18,7 @@ import Data.JSDate as JSDate
|
|||||||
import Data.Maybe (Maybe(..), fromJust)
|
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 Database.PostgreSQL (Connection, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, query, scalar, withConnection, withTransaction)
|
import Database.PostgreSQL (Connection, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, query, scalar, withConnection, withTransaction)
|
||||||
import Effect (Effect)
|
import Effect (Effect)
|
||||||
import Effect.Aff (Aff, error, launchAff)
|
import Effect.Aff (Aff, error, launchAff)
|
||||||
@ -26,6 +27,7 @@ import Foreign.Object (Object, fromFoldable)
|
|||||||
import Math ((%))
|
import Math ((%))
|
||||||
import Partial.Unsafe (unsafePartial)
|
import Partial.Unsafe (unsafePartial)
|
||||||
import Test.Assert (assert)
|
import Test.Assert (assert)
|
||||||
|
import Test.Example (run) as Example
|
||||||
import Test.Unit (TestF, suite)
|
import Test.Unit (TestF, suite)
|
||||||
import Test.Unit as Test.Unit
|
import Test.Unit as Test.Unit
|
||||||
import Test.Unit.Assert (equal)
|
import Test.Unit.Assert (equal)
|
||||||
@ -61,188 +63,210 @@ jsdate_ year month day hour minute second millisecond =
|
|||||||
jsdate { year, month, day, hour, minute, second, millisecond }
|
jsdate { year, month, day, hour, minute, second, millisecond }
|
||||||
|
|
||||||
main ∷ Effect Unit
|
main ∷ Effect Unit
|
||||||
main = void $ launchAff do
|
main = do
|
||||||
pool <- newPool config
|
void $ launchAff do
|
||||||
withConnection pool \conn -> do
|
-- Running guide from README
|
||||||
execute conn (Query """
|
Example.run
|
||||||
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
|
-- Acctual test suite
|
||||||
suite "Postgresql client" $ do
|
pool <- newPool config
|
||||||
let
|
withConnection pool \conn -> do
|
||||||
testCount n = do
|
execute conn (Query """
|
||||||
count <- scalar conn (Query """
|
CREATE TEMPORARY TABLE foods (
|
||||||
SELECT count(*) = $1
|
name text NOT NULL,
|
||||||
FROM foods
|
delicious boolean NOT NULL,
|
||||||
""") (Row1 n)
|
price NUMERIC(4,2) NOT NULL,
|
||||||
liftEffect <<< assert $ count == Just true
|
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
|
||||||
|
|
||||||
Test.Unit.test "transaction commit" $ do
|
liftEffect $ runTest $ do
|
||||||
withTransaction conn do
|
suite "Postgresql client" $ do
|
||||||
execute conn (Query """
|
let
|
||||||
INSERT INTO foods (name, delicious, price)
|
testCount n = do
|
||||||
VALUES ($1, $2, $3)
|
count <- scalar conn (Query """
|
||||||
""") (Row3 "pork" true (D.fromString "8.30"))
|
SELECT count(*) = $1
|
||||||
|
FROM foods
|
||||||
|
""") (Row1 n)
|
||||||
|
liftEffect <<< assert $ count == Just true
|
||||||
|
|
||||||
|
Test.Unit.test "transaction commit" $ do
|
||||||
|
withTransaction conn do
|
||||||
|
execute conn (Query """
|
||||||
|
INSERT INTO foods (name, delicious, price)
|
||||||
|
VALUES ($1, $2, $3)
|
||||||
|
""") (Row3 "pork" true (D.fromString "8.30"))
|
||||||
|
testCount 1
|
||||||
testCount 1
|
testCount 1
|
||||||
testCount 1
|
|
||||||
execute conn (Query """
|
|
||||||
DELETE FROM foods
|
|
||||||
""") Row0
|
|
||||||
|
|
||||||
Test.Unit.test "transaction rollback" $ do
|
|
||||||
_ <- try $ withTransaction conn do
|
|
||||||
execute conn (Query """
|
execute conn (Query """
|
||||||
INSERT INTO foods (name, delicious, price)
|
DELETE FROM foods
|
||||||
VALUES ($1, $2, $3)
|
""") Row0
|
||||||
""") (Row3 "pork" true (D.fromString "8.30"))
|
|
||||||
testCount 1
|
|
||||||
throwError $ error "fail"
|
|
||||||
testCount 0
|
|
||||||
|
|
||||||
let
|
Test.Unit.test "transaction rollback" $ do
|
||||||
insertFood =
|
_ <- try $ withTransaction conn do
|
||||||
|
execute conn (Query """
|
||||||
|
INSERT INTO foods (name, delicious, price)
|
||||||
|
VALUES ($1, $2, $3)
|
||||||
|
""") (Row3 "pork" true (D.fromString "8.30"))
|
||||||
|
testCount 1
|
||||||
|
throwError $ error "fail"
|
||||||
|
testCount 0
|
||||||
|
|
||||||
|
test conn "usage of rows represented by nested tuples" $ do
|
||||||
execute conn (Query """
|
execute conn (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
|
""")
|
||||||
"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"))
|
||||||
test conn "select column subset" $ do
|
names <- query conn (Query """
|
||||||
insertFood
|
SELECT name, delicious
|
||||||
names <- query conn (Query """
|
FROM foods
|
||||||
SELECT name, delicious
|
WHERE delicious
|
||||||
FROM foods
|
ORDER BY name ASC
|
||||||
WHERE delicious
|
""") Row0
|
||||||
ORDER BY name ASC
|
liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true]
|
||||||
""") Row0
|
|
||||||
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]
|
|
||||||
|
|
||||||
test conn "delete returning columns subset" $ do
|
|
||||||
insertFood
|
|
||||||
deleted <- query conn (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
|
|
||||||
insertFood
|
|
||||||
deleted <- command conn (Query """
|
|
||||||
DELETE FROM foods
|
|
||||||
WHERE delicious
|
|
||||||
""") Row0
|
|
||||||
liftEffect <<< assert $ deleted == 2
|
|
||||||
|
|
||||||
test conn "handling instant value" $ do
|
|
||||||
before <- liftEffect $ (unwrap <<< unInstant) <$> now
|
|
||||||
insertFood
|
|
||||||
added <- query conn (Query """
|
|
||||||
SELECT added
|
|
||||||
FROM foods
|
|
||||||
""") Row0
|
|
||||||
after <- liftEffect $ (unwrap <<< unInstant) <$> now
|
|
||||||
-- | timestamps are fetched without milliseconds so we have to
|
|
||||||
-- | round before value down
|
|
||||||
liftEffect <<< assert $ all
|
|
||||||
(\(Row1 t) ->
|
|
||||||
( unwrap $ unInstant t) >= (before - before % 1000.0)
|
|
||||||
&& after >= (unwrap $ unInstant t))
|
|
||||||
added
|
|
||||||
|
|
||||||
test conn "handling decimal value" $ do
|
|
||||||
insertFood
|
|
||||||
sauerkrautPrice <- query conn (Query """
|
|
||||||
SELECT price
|
|
||||||
FROM foods
|
|
||||||
WHERE NOT delicious
|
|
||||||
""") Row0
|
|
||||||
liftEffect <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")]
|
|
||||||
|
|
||||||
test conn "constraint failure" $ do
|
|
||||||
withTransaction conn $ do
|
|
||||||
result <- try $ execute conn (Query """
|
|
||||||
INSERT INTO foods (name)
|
|
||||||
VALUES ($1)
|
|
||||||
""") (Row1 "pork")
|
|
||||||
liftEffect <<< assert $ isLeft result
|
|
||||||
testCount 0
|
|
||||||
|
|
||||||
test conn "handling date value" $ do
|
|
||||||
let
|
let
|
||||||
d1 = date 2010 2 31
|
insertFood =
|
||||||
d2 = date 2017 2 1
|
execute conn (Query """
|
||||||
d3 = date 2020 6 31
|
INSERT INTO foods (name, delicious, price)
|
||||||
|
VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
|
||||||
|
""") (Row9
|
||||||
|
"pork" true (D.fromString "8.30")
|
||||||
|
"sauerkraut" false (D.fromString "3.30")
|
||||||
|
"rookworst" true (D.fromString "5.60"))
|
||||||
|
|
||||||
execute conn (Query """
|
test conn "select column subset" $ do
|
||||||
INSERT INTO dates (date)
|
insertFood
|
||||||
VALUES ($1), ($2), ($3)
|
names <- query conn (Query """
|
||||||
""") (Row3 d1 d2 d3)
|
SELECT name, delicious
|
||||||
|
FROM foods
|
||||||
|
WHERE delicious
|
||||||
|
ORDER BY name ASC
|
||||||
|
""") Row0
|
||||||
|
liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]
|
||||||
|
|
||||||
(dates :: Array (Row1 Date)) <- query conn (Query """
|
test conn "delete returning columns subset" $ do
|
||||||
SELECT *
|
insertFood
|
||||||
FROM dates
|
deleted <- query conn (Query """
|
||||||
ORDER BY date ASC
|
DELETE FROM foods
|
||||||
""") Row0
|
WHERE delicious
|
||||||
equal 3 (length dates)
|
RETURNING name, delicious
|
||||||
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
|
""") Row0
|
||||||
|
liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true]
|
||||||
|
|
||||||
test conn "handling json and jsonb value" $ do
|
test conn "delete returning command tag value" $ do
|
||||||
let jsonIn = fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
|
insertFood
|
||||||
let expected = fromFoldable [Tuple "a" 2, Tuple "2" 3]
|
deleted <- command conn (Query """
|
||||||
|
DELETE FROM foods
|
||||||
|
WHERE delicious
|
||||||
|
""") Row0
|
||||||
|
liftEffect <<< assert $ deleted == 2
|
||||||
|
|
||||||
execute conn (Query """
|
test conn "handling instant value" $ do
|
||||||
INSERT INTO jsons (json, jsonb)
|
before <- liftEffect $ (unwrap <<< unInstant) <$> now
|
||||||
VALUES ($1, $2)
|
insertFood
|
||||||
""") (Row2 jsonIn jsonIn)
|
added <- query conn (Query """
|
||||||
|
SELECT added
|
||||||
|
FROM foods
|
||||||
|
""") Row0
|
||||||
|
after <- liftEffect $ (unwrap <<< unInstant) <$> now
|
||||||
|
-- | timestamps are fetched without milliseconds so we have to
|
||||||
|
-- | round before value down
|
||||||
|
liftEffect <<< assert $ all
|
||||||
|
(\(Row1 t) ->
|
||||||
|
( unwrap $ unInstant t) >= (before - before % 1000.0)
|
||||||
|
&& after >= (unwrap $ unInstant t))
|
||||||
|
added
|
||||||
|
|
||||||
(js ∷ Array (Row2 (Object Int) (Object Int))) <- query conn (Query """SELECT * FROM JSONS""") Row0
|
test conn "handling decimal value" $ do
|
||||||
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js
|
insertFood
|
||||||
|
sauerkrautPrice <- query conn (Query """
|
||||||
|
SELECT price
|
||||||
|
FROM foods
|
||||||
|
WHERE NOT delicious
|
||||||
|
""") Row0
|
||||||
|
liftEffect <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")]
|
||||||
|
|
||||||
test conn "handling jsdate value" $ do
|
test conn "constraint failure" $ do
|
||||||
let
|
withTransaction conn $ do
|
||||||
jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0
|
result <- try $ execute conn (Query """
|
||||||
jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0
|
INSERT INTO foods (name)
|
||||||
jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0
|
VALUES ($1)
|
||||||
|
""") (Row1 "pork")
|
||||||
|
liftEffect <<< assert $ isLeft result
|
||||||
|
testCount 0
|
||||||
|
|
||||||
execute conn (Query """
|
test conn "handling date value" $ do
|
||||||
INSERT INTO timestamps (timestamp)
|
let
|
||||||
VALUES ($1), ($2), ($3)
|
d1 = date 2010 2 31
|
||||||
""") (Row3 jsd1 jsd2 jsd3)
|
d2 = date 2017 2 1
|
||||||
|
d3 = date 2020 6 31
|
||||||
|
|
||||||
(timestamps :: Array (Row1 JSDate)) <- query conn (Query """
|
execute conn (Query """
|
||||||
SELECT *
|
INSERT INTO dates (date)
|
||||||
FROM timestamps
|
VALUES ($1), ($2), ($3)
|
||||||
ORDER BY timestamp ASC
|
""") (Row3 d1 d2 d3)
|
||||||
""") Row0
|
|
||||||
equal 3 (length timestamps)
|
(dates :: Array (Row1 Date)) <- query conn (Query """
|
||||||
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [jsd1, jsd2, jsd3])
|
SELECT *
|
||||||
|
FROM dates
|
||||||
|
ORDER BY date ASC
|
||||||
|
""") Row0
|
||||||
|
equal 3 (length dates)
|
||||||
|
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
|
||||||
|
|
||||||
|
test conn "handling json and jsonb value" $ do
|
||||||
|
let jsonIn = fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
|
||||||
|
let expected = fromFoldable [Tuple "a" 2, Tuple "2" 3]
|
||||||
|
|
||||||
|
execute conn (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
|
||||||
|
liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js
|
||||||
|
|
||||||
|
test conn "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 """
|
||||||
|
INSERT INTO timestamps (timestamp)
|
||||||
|
VALUES ($1), ($2), ($3)
|
||||||
|
""") (Row3 jsd1 jsd2 jsd3)
|
||||||
|
|
||||||
|
(timestamps :: Array (Row1 JSDate)) <- query conn (Query """
|
||||||
|
SELECT *
|
||||||
|
FROM timestamps
|
||||||
|
ORDER BY timestamp ASC
|
||||||
|
""") Row0
|
||||||
|
equal 3 (length timestamps)
|
||||||
|
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [jsd1, jsd2, jsd3])
|
||||||
|
|
||||||
config :: PoolConfiguration
|
config :: PoolConfiguration
|
||||||
config =
|
config =
|
||||||
{ user: "postgres"
|
{ user: Nothing
|
||||||
, password: "lol123"
|
, password: Nothing
|
||||||
, host: "127.0.0.1"
|
, host: Nothing
|
||||||
, port: 5432
|
, port: Nothing
|
||||||
, database: "purspg"
|
, database: "purspg"
|
||||||
, max: 10
|
, max: Nothing
|
||||||
, idleTimeoutMillis: 1000
|
, idleTimeoutMillis: Just 1000
|
||||||
}
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user