From b49c94ed2a2b81a3f134ec44984555cbda38a02a Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Sat, 20 Apr 2024 13:59:11 +0300 Subject: [PATCH 1/2] Factor constants out --- hasql.cabal | 3 ++- tasty/Main.hs | 2 +- testing-utils/Hasql/TestingUtils/Constants.hs | 13 +++++++++++++ .../TestingUtils/{Session.hs => TestingDsl.hs} | 14 +++----------- 4 files changed, 19 insertions(+), 13 deletions(-) create mode 100644 testing-utils/Hasql/TestingUtils/Constants.hs rename testing-utils/Hasql/TestingUtils/{Session.hs => TestingDsl.hs} (76%) diff --git a/hasql.cabal b/hasql.cabal index 4ea6717..b581325 100644 --- a/hasql.cabal +++ b/hasql.cabal @@ -140,7 +140,8 @@ library testing-utils import: base hs-source-dirs: testing-utils exposed-modules: - Hasql.TestingUtils.Session + Hasql.TestingUtils.Constants + Hasql.TestingUtils.TestingDsl build-depends: hasql, diff --git a/tasty/Main.hs b/tasty/Main.hs index 0dff5c2..1f57ef3 100644 --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -5,7 +5,7 @@ import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders import Hasql.Session qualified as Session import Hasql.Statement qualified as Statement -import Hasql.TestingUtils.Session qualified as Session +import Hasql.TestingUtils.TestingDsl qualified as Session import Main.Connection qualified as Connection import Main.Prelude hiding (assert) import Main.Statements qualified as Statements diff --git a/testing-utils/Hasql/TestingUtils/Constants.hs b/testing-utils/Hasql/TestingUtils/Constants.hs new file mode 100644 index 0000000..be657f7 --- /dev/null +++ b/testing-utils/Hasql/TestingUtils/Constants.hs @@ -0,0 +1,13 @@ +module Hasql.TestingUtils.Constants where + +import Hasql.Connection qualified as Connection + +localConnectionSettings :: Connection.Settings +localConnectionSettings = + Connection.settings host port user password database + where + host = "localhost" + port = 5432 + user = "postgres" + password = "postgres" + database = "postgres" diff --git a/testing-utils/Hasql/TestingUtils/Session.hs b/testing-utils/Hasql/TestingUtils/TestingDsl.hs similarity index 76% rename from testing-utils/Hasql/TestingUtils/Session.hs rename to testing-utils/Hasql/TestingUtils/TestingDsl.hs index f9fe865..9a82667 100644 --- a/testing-utils/Hasql/TestingUtils/Session.hs +++ b/testing-utils/Hasql/TestingUtils/TestingDsl.hs @@ -1,4 +1,4 @@ -module Hasql.TestingUtils.Session +module Hasql.TestingUtils.TestingDsl ( Session.Session, SessionError (..), Session.QueryError (..), @@ -11,6 +11,7 @@ where import Hasql.Connection qualified as Connection import Hasql.Session qualified as Session import Hasql.Statement qualified as Statement +import Hasql.TestingUtils.Constants qualified as Constants import Prelude data SessionError @@ -23,16 +24,7 @@ runSession session = runExceptT $ acquire >>= \connection -> use connection <* release connection where acquire = - ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire settings - where - settings = - Connection.settings host port user password database - where - host = "localhost" - port = 5432 - user = "postgres" - password = "postgres" - database = "postgres" + ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire Constants.localConnectionSettings use connection = ExceptT $ fmap (mapLeft SessionError) From 84292fb75509f2598fe6864af32861c73dc20a0c Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Sat, 20 Apr 2024 14:01:58 +0300 Subject: [PATCH 2/2] Rename runSession to runSessionOnLocalDb --- tasty/Main.hs | 24 +++++++++---------- .../Hasql/TestingUtils/TestingDsl.hs | 6 ++--- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/tasty/Main.hs b/tasty/Main.hs index 1f57ef3..132e16b 100644 --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -136,7 +136,7 @@ tree = assertEqual (show x) (Right (Right ((1, True), ("hello", 3)))) x, testGroup "unknownEnum" $ [ testCase "" $ do - res <- Session.runSession $ do + res <- Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql mempty Decoders.noResult True where @@ -301,12 +301,12 @@ tree = s <- Session.statement (1, 1) sumStatement Session.sql "end;" return s - in Session.runSession session >>= \x -> assertEqual (show x) (Right 2) x, + in Session.runSessionOnLocalDb session >>= \x -> assertEqual (show x) (Right 2) x, testCase "Executing the same query twice" $ pure (), testCase "Interval Encoding" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql encoder decoder True where @@ -320,7 +320,7 @@ tree = in actualIO >>= \x -> assertEqual (show x) (Right True) x, testCase "Interval Decoding" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql encoder decoder True where @@ -334,7 +334,7 @@ tree = in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x, testCase "Interval Encoding/Decoding" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql encoder decoder True where @@ -348,7 +348,7 @@ tree = in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x, testCase "Unknown" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql mempty Decoders.noResult True where @@ -374,7 +374,7 @@ tree = in actualIO >>= assertEqual "" (Right True), testCase "Textual Unknown" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql mempty Decoders.noResult True where @@ -400,7 +400,7 @@ tree = in actualIO >>= assertEqual "" (Right "3456"), testCase "Enum" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let statement = Statement.Statement sql mempty Decoders.noResult True where @@ -426,7 +426,7 @@ tree = in actualIO >>= assertEqual "" (Right "ok"), testCase "The same prepared statement used on different types" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do let effect1 = Session.statement "ok" statement where @@ -456,7 +456,7 @@ tree = testCase "Affected rows counting" $ replicateM_ 13 $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do dropTable createTable replicateM_ 100 insertRow @@ -484,7 +484,7 @@ tree = in actualIO >>= assertEqual "" (Right 100), testCase "Result of an auto-incremented column" $ let actualIO = - Session.runSession $ do + Session.runSessionOnLocalDb $ do Session.statement () $ Statements.plain $ "drop table if exists a" Session.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))" id1 <- Session.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False @@ -494,6 +494,6 @@ tree = in assertEqual "" (Right (1, 2)) =<< actualIO, testCase "List decoding" $ let actualIO = - Session.runSession $ Session.statement () $ Statements.selectList + Session.runSessionOnLocalDb $ Session.statement () $ Statements.selectList in assertEqual "" (Right [(1, 2), (3, 4), (5, 6)]) =<< actualIO ] diff --git a/testing-utils/Hasql/TestingUtils/TestingDsl.hs b/testing-utils/Hasql/TestingUtils/TestingDsl.hs index 9a82667..c5cacfb 100644 --- a/testing-utils/Hasql/TestingUtils/TestingDsl.hs +++ b/testing-utils/Hasql/TestingUtils/TestingDsl.hs @@ -3,7 +3,7 @@ module Hasql.TestingUtils.TestingDsl SessionError (..), Session.QueryError (..), Session.CommandError (..), - runSession, + runSessionOnLocalDb, runStatementInSession, ) where @@ -19,8 +19,8 @@ data SessionError | SessionError (Session.QueryError) deriving (Show, Eq) -runSession :: Session.Session a -> IO (Either SessionError a) -runSession session = +runSessionOnLocalDb :: Session.Session a -> IO (Either SessionError a) +runSessionOnLocalDb session = runExceptT $ acquire >>= \connection -> use connection <* release connection where acquire =