Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
a75d6e90
Commit
a75d6e90
authored
Apr 28, 2025
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add final (simple) tests
.. before we start adding the transactional tests (and testing the rollback).
parent
b14c2506
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
38 additions
and
5 deletions
+38
-5
Transactional.hs
src/Gargantext/Database/Transactional.hs
+1
-0
Transactions.hs
test/Test/Database/Transactions.hs
+37
-5
No files found.
src/Gargantext/Database/Transactional.hs
View file @
a75d6e90
...
@@ -145,6 +145,7 @@ queryOne conn q v = do
...
@@ -145,6 +145,7 @@ queryOne conn q v = do
rs
<-
PG
.
query
conn
q
v
rs
<-
PG
.
query
conn
q
v
case
rs
of
case
rs
of
[
x
]
->
pure
x
[
x
]
->
pure
x
[ ]
->
Safe
.
throwIO
$
userError
"queryOne: no result returned. Check your SQL!"
_
->
Safe
.
throwIO
$
userError
"queryOne: more than one result returned. Have you used the 'RETURNING' directive?"
_
->
Safe
.
throwIO
$
userError
"queryOne: more than one result returned. Have you used the 'RETURNING' directive?"
--
--
...
...
test/Test/Database/Transactions.hs
View file @
a75d6e90
...
@@ -18,8 +18,13 @@ import Data.String
...
@@ -18,8 +18,13 @@ import Data.String
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Data.Text.Encoding
qualified
as
TE
import
Data.Text.Encoding
qualified
as
TE
import
Database.PostgreSQL.Simple
qualified
as
PG
import
Database.PostgreSQL.Simple
qualified
as
PG
import
Database.PostgreSQL.Simple.FromField
import
Database.PostgreSQL.Simple.FromRow
import
Database.PostgreSQL.Simple.Options
qualified
as
Client
import
Database.PostgreSQL.Simple.Options
qualified
as
Client
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.ToField
import
Database.Postgres.Temp
qualified
as
Tmp
import
Database.Postgres.Temp
qualified
as
Tmp
import
Gargantext.Database.Transactional
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Prelude
qualified
import
Prelude
qualified
import
Shelly
as
SH
import
Shelly
as
SH
...
@@ -27,10 +32,6 @@ import Test.Database.Types hiding (Counter)
...
@@ -27,10 +32,6 @@ import Test.Database.Types hiding (Counter)
import
Test.Hspec
import
Test.Hspec
import
Test.Tasty.HUnit
hiding
(
assert
)
import
Test.Tasty.HUnit
hiding
(
assert
)
import
Text.RawString.QQ
import
Text.RawString.QQ
import
Gargantext.Database.Transactional
import
Database.PostgreSQL.Simple.FromField
import
Database.PostgreSQL.Simple.FromRow
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
--
--
-- For these tests we do not want to test the normal GGTX database queries, but rather
-- For these tests we do not want to test the normal GGTX database queries, but rather
...
@@ -122,7 +123,7 @@ teardown test_db = do
...
@@ -122,7 +123,7 @@ teardown test_db = do
--
--
newtype
CounterId
=
CounterId
{
_CounterId
::
Int
}
newtype
CounterId
=
CounterId
{
_CounterId
::
Int
}
deriving
(
Show
,
Eq
,
FromField
)
deriving
(
Show
,
Eq
,
ToField
,
FromField
)
data
Counter
=
Counter
data
Counter
=
Counter
{
counterId
::
!
CounterId
{
counterId
::
!
CounterId
...
@@ -144,6 +145,16 @@ insertCounter :: DBUpdate IOException Counter
...
@@ -144,6 +145,16 @@ insertCounter :: DBUpdate IOException Counter
insertCounter
=
do
insertCounter
=
do
mkPGUpdateReturning
[
sql
|
INSERT INTO public.ggtx_test_counter_table(counter_value) VALUES(0) RETURNING id, counter_value
|]
()
mkPGUpdateReturning
[
sql
|
INSERT INTO public.ggtx_test_counter_table(counter_value) VALUES(0) RETURNING id, counter_value
|]
()
updateCounter
::
CounterId
->
Int
->
DBUpdate
IOException
Counter
updateCounter
cid
x
=
do
mkPGUpdateReturning
[
sql
|
UPDATE public.ggtx_test_counter_table SET counter_value = ? WHERE id = ? RETURNING *
|]
(
x
,
cid
)
-- | We deliberately write this as a composite operation.
stepCounter
::
CounterId
->
DBUpdate
IOException
Counter
stepCounter
cid
=
do
Counter
{
..
}
<-
getCounterById
cid
mkPGUpdateReturning
[
sql
|
UPDATE public.ggtx_test_counter_table SET counter_value = ? WHERE id = ? RETURNING *
|]
(
counterValue
+
1
,
cid
)
--
--
-- MAIN TESTS
-- MAIN TESTS
--
--
...
@@ -155,6 +166,10 @@ tests = parallel $ around withTestCounterDB $
...
@@ -155,6 +166,10 @@ tests = parallel $ around withTestCounterDB $
it
"Simple query works"
simplePGQueryWorks
it
"Simple query works"
simplePGQueryWorks
describe
"Pure PG Inserts"
$
do
describe
"Pure PG Inserts"
$
do
it
"Simple insert works"
simplePGInsertWorks
it
"Simple insert works"
simplePGInsertWorks
describe
"Pure PG Updates"
$
do
it
"Simple updates works"
simplePGUpdateWorks
describe
"PG Queries and Updates"
$
do
it
"Supports mixing queries and updates"
mixQueriesAndUpdates
simplePGQueryWorks
::
DBHandle
->
Assertion
simplePGQueryWorks
::
DBHandle
->
Assertion
simplePGQueryWorks
env
=
flip
runReaderT
env
$
runTestMonad
$
do
simplePGQueryWorks
env
=
flip
runReaderT
env
$
runTestMonad
$
do
...
@@ -165,3 +180,20 @@ simplePGInsertWorks :: DBHandle -> Assertion
...
@@ -165,3 +180,20 @@ simplePGInsertWorks :: DBHandle -> Assertion
simplePGInsertWorks
env
=
flip
runReaderT
env
$
runTestMonad
$
do
simplePGInsertWorks
env
=
flip
runReaderT
env
$
runTestMonad
$
do
x
<-
runDBTx
$
insertCounter
x
<-
runDBTx
$
insertCounter
liftIO
$
x
`
shouldBe
`
(
Counter
(
CounterId
2
)
0
)
liftIO
$
x
`
shouldBe
`
(
Counter
(
CounterId
2
)
0
)
simplePGUpdateWorks
::
DBHandle
->
Assertion
simplePGUpdateWorks
env
=
flip
runReaderT
env
$
runTestMonad
$
do
x
<-
runDBTx
$
updateCounter
(
CounterId
1
)
99
liftIO
$
x
`
shouldBe
`
(
Counter
(
CounterId
1
)
99
)
mixQueriesAndUpdates
::
DBHandle
->
Assertion
mixQueriesAndUpdates
env
=
flip
runReaderT
env
$
runTestMonad
$
do
(
final_1
,
final_2
)
<-
runDBTx
$
do
c1
<-
insertCounter
c2
<-
insertCounter
c1'
<-
getCounterById
(
counterId
c1
)
c2'
<-
stepCounter
(
counterId
c2
)
pure
(
c1'
,
c2'
)
liftIO
$
do
final_1
`
shouldBe
`
(
Counter
(
CounterId
2
)
0
)
final_2
`
shouldBe
`
(
Counter
(
CounterId
3
)
1
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment