From b9dbc64eb269b520ddfe0d467f27bbbce980d8cc Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 16:25:57 -0600 Subject: [PATCH 1/2] Expose Raw.Internal module for testing --- persistent/Database/Persist/Sql.hs | 2 +- persistent/Database/Persist/Sql/Migration.hs | 2 +- .../Database/Persist/Sql/Orphan/PersistQuery.hs | 2 +- .../Database/Persist/Sql/Orphan/PersistStore.hs | 2 +- .../Persist/Sql/Orphan/PersistUnique.hs | 2 +- .../Persist/Sql/{Raw.hs => Raw/Internal.hs} | 8 +++++--- persistent/Database/Persist/Sql/Run.hs | 2 +- .../Database/Persist/SqlBackend/SqlPoolHooks.hs | 2 +- persistent/persistent.cabal | 17 +++++++++-------- persistent/test/Database/Persist/Sql/RawSpec.hs | 8 ++++++++ persistent/test/main.hs | 4 ++++ 11 files changed, 33 insertions(+), 18 deletions(-) rename persistent/Database/Persist/Sql/{Raw.hs => Raw/Internal.hs} (97%) create mode 100644 persistent/test/Database/Persist/Sql/RawSpec.hs diff --git a/persistent/Database/Persist/Sql.hs b/persistent/Database/Persist/Sql.hs index 32bba1021..8c39766e5 100644 --- a/persistent/Database/Persist/Sql.hs +++ b/persistent/Database/Persist/Sql.hs @@ -66,7 +66,7 @@ import Database.Persist import Database.Persist.Sql.Class import Database.Persist.Sql.Internal import Database.Persist.Sql.Migration -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Run hiding (rawAcquireSqlConn, rawRunSqlPool) import Database.Persist.Sql.Types import Database.Persist.Sql.Types.Internal (IsolationLevel(..), SqlBackend(..)) diff --git a/persistent/Database/Persist/Sql/Migration.hs b/persistent/Database/Persist/Sql/Migration.hs index c4e3b8e22..8a2b11712 100644 --- a/persistent/Database/Persist/Sql/Migration.hs +++ b/persistent/Database/Persist/Sql/Migration.hs @@ -68,7 +68,7 @@ import System.IO import System.IO.Silently (hSilence) import Database.Persist.Sql.Orphan.PersistStore () -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Types import Database.Persist.Sql.Types.Internal import Database.Persist.Types diff --git a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs index 4651d154b..74206d4e9 100644 --- a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs +++ b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs @@ -31,7 +31,7 @@ import qualified Data.Text as T import Database.Persist hiding (updateField) import Database.Persist.Sql.Orphan.PersistStore (withRawQuery) -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Types.Internal (SqlBackend(..), SqlReadBackend, SqlWriteBackend) import Database.Persist.Sql.Util diff --git a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs index eacd14829..19be2dff9 100644 --- a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs +++ b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs @@ -40,7 +40,7 @@ import Web.PathPieces (PathPiece) import Database.Persist import Database.Persist.Class () import Database.Persist.Sql.Class (PersistFieldSql) -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Types import Database.Persist.Sql.Types.Internal import Database.Persist.Sql.Util diff --git a/persistent/Database/Persist/Sql/Orphan/PersistUnique.hs b/persistent/Database/Persist/Sql/Orphan/PersistUnique.hs index a67ff21da..c99a8a89a 100644 --- a/persistent/Database/Persist/Sql/Orphan/PersistUnique.hs +++ b/persistent/Database/Persist/Sql/Orphan/PersistUnique.hs @@ -17,7 +17,7 @@ import Database.Persist import Database.Persist.Class.PersistUnique (defaultUpsertBy, defaultPutMany, persistUniqueKeyValues) import Database.Persist.Sql.Types.Internal -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Orphan.PersistStore (withRawQuery) import Database.Persist.Sql.Util (dbColumns, parseEntityValues, updatePersistValue, mkUpdateText') diff --git a/persistent/Database/Persist/Sql/Raw.hs b/persistent/Database/Persist/Sql/Raw/Internal.hs similarity index 97% rename from persistent/Database/Persist/Sql/Raw.hs rename to persistent/Database/Persist/Sql/Raw/Internal.hs index c458c2716..caf929c32 100644 --- a/persistent/Database/Persist/Sql/Raw.hs +++ b/persistent/Database/Persist/Sql/Raw/Internal.hs @@ -1,4 +1,6 @@ -module Database.Persist.Sql.Raw where +-- | This module is a internal. Breaking changes to the API of this module will +-- not be reflected in a major version bump. +module Database.Persist.Sql.Raw.Internal where import Control.Exception (throwIO) import Control.Monad (liftM, when) @@ -216,10 +218,10 @@ rawSql stmt = run process = rawSqlProcessRow withStmt' colSubsts params sink = do - srcRes <- rawQueryRes sql params + srcRes <- rawQueryRes sql' params liftIO $ with srcRes (\src -> runConduit $ src .| sink) where - sql = T.concat $ makeSubsts colSubsts $ T.splitOn placeholder stmt + sql' = T.concat $ makeSubsts colSubsts $ T.splitOn placeholder stmt placeholder = "??" makeSubsts (s:ss) (t:ts) = t : s : makeSubsts ss ts makeSubsts [] [] = [] diff --git a/persistent/Database/Persist/Sql/Run.hs b/persistent/Database/Persist/Sql/Run.hs index f1baea5e5..4233a6f91 100644 --- a/persistent/Database/Persist/Sql/Run.hs +++ b/persistent/Database/Persist/Sql/Run.hs @@ -15,7 +15,7 @@ import qualified Data.Text as T import qualified UnliftIO.Exception as UE import Database.Persist.Class.PersistStore -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.Sql.Types import Database.Persist.Sql.Types.Internal import Database.Persist.SqlBackend.Internal.StatementCache diff --git a/persistent/Database/Persist/SqlBackend/SqlPoolHooks.hs b/persistent/Database/Persist/SqlBackend/SqlPoolHooks.hs index c180a1d1a..c19bb4aa4 100644 --- a/persistent/Database/Persist/SqlBackend/SqlPoolHooks.hs +++ b/persistent/Database/Persist/SqlBackend/SqlPoolHooks.hs @@ -16,7 +16,7 @@ module Database.Persist.SqlBackend.SqlPoolHooks import Control.Exception import Control.Monad.IO.Class -import Database.Persist.Sql.Raw +import Database.Persist.Sql.Raw.Internal import Database.Persist.SqlBackend.Internal import Database.Persist.SqlBackend.Internal.SqlPoolHooks import Database.Persist.SqlBackend.Internal.IsolationLevel diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index b88485ddb..14e9476bd 100644 --- a/persistent/persistent.cabal +++ b/persistent/persistent.cabal @@ -68,7 +68,9 @@ library Database.Persist.Quasi.Internal Database.Persist.Sql + Database.Persist.Sql.Internal Database.Persist.Sql.Migration + Database.Persist.Sql.Raw.Internal Database.Persist.Sql.Types.Internal Database.Persist.Sql.Util @@ -95,9 +97,7 @@ library other-modules: Database.Persist.Types.Base - Database.Persist.Sql.Internal Database.Persist.Sql.Types - Database.Persist.Sql.Raw Database.Persist.Sql.Run Database.Persist.Sql.Class Database.Persist.Sql.Orphan.PersistQuery @@ -166,26 +166,27 @@ test-suite test Database.Persist.ClassSpec Database.Persist.PersistValueSpec Database.Persist.QuasiSpec + Database.Persist.Sql.RawSpec + Database.Persist.TH.CommentSpec Database.Persist.TH.DiscoverEntitiesSpec Database.Persist.TH.EmbedSpec Database.Persist.TH.ForeignRefSpec - Database.Persist.TH.PersistWith.Model - Database.Persist.TH.PersistWith.Model2 - Database.Persist.TH.PersistWithSpec - Database.Persist.TH.CommentSpec Database.Persist.TH.ImplicitIdColSpec Database.Persist.TH.JsonEncodingSpec Database.Persist.TH.KindEntitiesSpec Database.Persist.TH.KindEntitiesSpecImports - Database.Persist.TH.MigrationOnlySpec Database.Persist.TH.MaybeFieldDefsSpec + Database.Persist.TH.MigrationOnlySpec Database.Persist.TH.MultiBlockSpec Database.Persist.TH.MultiBlockSpec.Model Database.Persist.TH.OverloadedLabelSpec + Database.Persist.TH.PersistWith.Model + Database.Persist.TH.PersistWith.Model2 + Database.Persist.TH.PersistWithSpec Database.Persist.TH.SharedPrimaryKeyImportedSpec Database.Persist.TH.SharedPrimaryKeySpec - Database.Persist.THSpec Database.Persist.TH.ToFromPersistValuesSpec + Database.Persist.THSpec TemplateTestImports default-language: Haskell2010 diff --git a/persistent/test/Database/Persist/Sql/RawSpec.hs b/persistent/test/Database/Persist/Sql/RawSpec.hs new file mode 100644 index 000000000..c05f433f3 --- /dev/null +++ b/persistent/test/Database/Persist/Sql/RawSpec.hs @@ -0,0 +1,8 @@ +module Database.Persist.Sql.RawSpec where + +import Test.Hspec +import Database.Persist.Sql.Raw.Internal + +spec :: Spec +spec = do + pure () diff --git a/persistent/test/main.hs b/persistent/test/main.hs index b898bc84d..4b4186c86 100644 --- a/persistent/test/main.hs +++ b/persistent/test/main.hs @@ -6,6 +6,7 @@ import qualified Database.Persist.ClassSpec as ClassSpec import qualified Database.Persist.PersistValueSpec as PersistValueSpec import qualified Database.Persist.QuasiSpec as QuasiSpec import qualified Database.Persist.THSpec as THSpec +import qualified Database.Persist.Sql.RawSpec as RawSpec main :: IO () main = hspec $ do @@ -14,3 +15,6 @@ main = hspec $ do QuasiSpec.spec ClassSpec.spec PersistValueSpec.spec + describe "Sql" $ do + describe "RawSpec" $ do + RawSpec.spec From 12b43d185cf6a8da160b5a6aa70eed0629160a31 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Thu, 17 Mar 2022 16:41:06 -0600 Subject: [PATCH 2/2] Tests --- persistent-postgresql/test/PgInit.hs | 3 + persistent-postgresql/test/UpsertWhere.hs | 3 - persistent-test/src/RawSqlTest.hs | 270 ++++++++++++---------- 3 files changed, 146 insertions(+), 130 deletions(-) diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs index 87c9b447f..21fa59e0c 100644 --- a/persistent-postgresql/test/PgInit.hs +++ b/persistent-postgresql/test/PgInit.hs @@ -227,3 +227,6 @@ instance Arbitrary AValue where $ listOf -- [(,)] -> (,) . liftA2 (,) arbText -- (,) -> Text and Value $ limitIt 4 (fmap getValue arbitrary) -- Again, precaution against divergent recursion. + +itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ())) +itDb msg action = it msg $ runConnAssert $ void action diff --git a/persistent-postgresql/test/UpsertWhere.hs b/persistent-postgresql/test/UpsertWhere.hs index 433fac1e0..1a2d0fd01 100644 --- a/persistent-postgresql/test/UpsertWhere.hs +++ b/persistent-postgresql/test/UpsertWhere.hs @@ -46,9 +46,6 @@ wipe = runConnAssert $ do deleteWhere ([] :: [Filter Item]) deleteWhere ([] :: [Filter ItemMigOnly]) -itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ())) -itDb msg action = it msg $ runConnAssert $ void action - specs :: Spec specs = describe "UpsertWhere" $ do let item1 = Item "item1" "" (Just 3) Nothing diff --git a/persistent-test/src/RawSqlTest.hs b/persistent-test/src/RawSqlTest.hs index 33f6e9d97..31ac9d12b 100644 --- a/persistent-test/src/RawSqlTest.hs +++ b/persistent-test/src/RawSqlTest.hs @@ -3,6 +3,7 @@ module RawSqlTest where import Data.Coerce +import qualified Conduit as C import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Text as T @@ -13,133 +14,148 @@ import PersistTestPetType import PersistentTestModels specsWith :: Runner SqlBackend m => RunDb SqlBackend m -> Spec -specsWith runDb = describe "rawSql" $ do - it "2+2" $ runDb $ do - ret <- rawSql "SELECT 2+2" [] - liftIO $ ret @?= [Single (4::Int)] - - it "?-?" $ runDb $ do - ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3] - liftIO $ ret @?= [Single (2::Int)] - - it "NULL" $ runDb $ do - ret <- rawSql "SELECT NULL" [] - liftIO $ ret @?= [Nothing :: Maybe (Single Int)] - - it "entity" $ runDb $ do - Entity p1k p1 <- insertEntity $ Person "Mathias" 23 Nothing - Entity p2k p2 <- insertEntity $ Person "Norbert" 44 Nothing - Entity p3k _ <- insertEntity $ Person "Cassandra" 19 Nothing - Entity _ _ <- insertEntity $ Person "Thiago" 19 Nothing - Entity a1k a1 <- insertEntity $ Pet p1k "Rodolfo" Cat - Entity a2k a2 <- insertEntity $ Pet p1k "Zeno" Cat - Entity a3k a3 <- insertEntity $ Pet p2k "Lhama" Dog - Entity _ _ <- insertEntity $ Pet p3k "Abacate" Cat - escape <- getEscape - person <- getTableName (error "rawSql Person" :: Person) - name_ <- getFieldName PersonName - pet <- getTableName (error "rawSql Pet" :: Pet) - petName_ <- getFieldName PetName - let query = T.concat [ "SELECT ??, ?? " - , "FROM ", person - , ", ", escape "Pet" - , " WHERE ", person, ".", escape "age", " >= ? " - , "AND ", escape "Pet", ".", escape "ownerId", " = " - , person, ".", escape "id" - , " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_ - ] - ret <- rawSql query [PersistInt64 20] - liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1) - , (Entity p1k p1, Entity a2k a2) - , (Entity p2k p2, Entity a3k a3) ] - ret2 <- rawSql query [PersistInt64 20] - liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1)) - , (Just (Entity p1k p1), Just (Entity a2k a2)) - , (Just (Entity p2k p2), Just (Entity a3k a3)) ] - ret3 <- rawSql query [PersistInt64 20] - liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1) - , Just (Entity p1k p1, Entity a2k a2) - , Just (Entity p2k p2, Entity a3k a3) ] - - it "order-proof" $ runDb $ do - let p1 = Person "Zacarias" 93 Nothing - p1k <- insert p1 - escape <- getEscape - let query = T.concat [ "SELECT ?? " - , "FROM ", escape "Person" - ] - ret1 <- rawSql query [] - ret2 <- rawSql query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)] - liftIO $ ret1 @?= [Entity p1k p1] - liftIO $ ret2 @?= [Entity (RFOKey $ unPersonKey p1k) (RFO p1)] - - it "permits prefixes" $ runDb $ do - let r1 = Relationship "Foo" Nothing - r1k <- insert r1 - let r2 = Relationship "Bar" (Just r1k) - r2k <- insert r2 - let r3 = Relationship "Lmao" (Just r1k) - r3k <- insert r3 - let r4 = Relationship "Boring" (Just r2k) - r4k <- insert r4 - escape <- getEscape - let query = T.concat - [ "SELECT ??, ?? " - , "FROM ", escape "Relationship", " AS parent " - , "LEFT OUTER JOIN ", escape "Relationship", " AS child " - , "ON parent.id = child.parent" - ] - - result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <- - rawSql query [] - - liftIO $ - coerce result `shouldMatchList` - [ (Entity r1k r1, Just (Entity r2k r2)) - , (Entity r1k r1, Just (Entity r3k r3)) - , (Entity r2k r2, Just (Entity r4k r4)) - , (Entity r3k r3, Nothing) - , (Entity r4k r4, Nothing) - ] - - - it "OUTER JOIN" $ runDb $ do - let insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m) - => val -> ReaderT backend m (Key val, val) - insert' v = insert v >>= \k -> return (k, v) - (p1k, p1) <- insert' $ Person "Mathias" 23 Nothing - (p2k, p2) <- insert' $ Person "Norbert" 44 Nothing - (a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat - (a2k, a2) <- insert' $ Pet p1k "Zeno" Cat - escape <- getEscape - let query = T.concat [ "SELECT ??, ?? " - , "FROM ", person - , "LEFT OUTER JOIN ", pet - , " ON ", person, ".", escape "id" - , " = ", pet, ".", escape "ownerId" - , " ORDER BY ", person, ".", escape "name" - , ", ", pet, ".", escape "id" ] - person = escape "Person" - pet = escape "Pet" - ret <- rawSql query [] - liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1)) - , (Entity p1k p1, Just (Entity a2k a2)) - , (Entity p2k p2, Nothing) ] - - it "handles lower casing" $ - runDb $ do - C.runConduitRes $ rawQuery "SELECT full_name from lower_case_table WHERE my_id=5" [] C..| CL.sinkNull - C.runConduitRes $ rawQuery "SELECT something_else from ref_table WHERE id=4" [] C..| CL.sinkNull - - it "commit/rollback" $ do - caseCommitRollback runDb - runDb cleanDB - - it "queries with large number of results" $ runDb $ do - -- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples - -- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369 - ret <- rawSql "SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" $ map PersistInt64 [1..15] - liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))] +specsWith runDb = do + describe "rawSql" $ do + it "2+2" $ runDb $ do + ret <- rawSql "SELECT 2+2" [] + liftIO $ ret @?= [Single (4::Int)] + + it "?-?" $ runDb $ do + ret <- rawSql "SELECT ?-?" [PersistInt64 5, PersistInt64 3] + liftIO $ ret @?= [Single (2::Int)] + + it "NULL" $ runDb $ do + ret <- rawSql "SELECT NULL" [] + liftIO $ ret @?= [Nothing :: Maybe (Single Int)] + + it "entity" $ runDb $ do + Entity p1k p1 <- insertEntity $ Person "Mathias" 23 Nothing + Entity p2k p2 <- insertEntity $ Person "Norbert" 44 Nothing + Entity p3k _ <- insertEntity $ Person "Cassandra" 19 Nothing + Entity _ _ <- insertEntity $ Person "Thiago" 19 Nothing + Entity a1k a1 <- insertEntity $ Pet p1k "Rodolfo" Cat + Entity a2k a2 <- insertEntity $ Pet p1k "Zeno" Cat + Entity a3k a3 <- insertEntity $ Pet p2k "Lhama" Dog + Entity _ _ <- insertEntity $ Pet p3k "Abacate" Cat + escape <- getEscape + person <- getTableName (error "rawSql Person" :: Person) + name_ <- getFieldName PersonName + pet <- getTableName (error "rawSql Pet" :: Pet) + petName_ <- getFieldName PetName + let query = T.concat [ "SELECT ??, ?? " + , "FROM ", person + , ", ", escape "Pet" + , " WHERE ", person, ".", escape "age", " >= ? " + , "AND ", escape "Pet", ".", escape "ownerId", " = " + , person, ".", escape "id" + , " ORDER BY ", person, ".", name_, ", ", pet, ".", petName_ + ] + ret <- rawSql query [PersistInt64 20] + liftIO $ ret @?= [ (Entity p1k p1, Entity a1k a1) + , (Entity p1k p1, Entity a2k a2) + , (Entity p2k p2, Entity a3k a3) ] + ret2 <- rawSql query [PersistInt64 20] + liftIO $ ret2 @?= [ (Just (Entity p1k p1), Just (Entity a1k a1)) + , (Just (Entity p1k p1), Just (Entity a2k a2)) + , (Just (Entity p2k p2), Just (Entity a3k a3)) ] + ret3 <- rawSql query [PersistInt64 20] + liftIO $ ret3 @?= [ Just (Entity p1k p1, Entity a1k a1) + , Just (Entity p1k p1, Entity a2k a2) + , Just (Entity p2k p2, Entity a3k a3) ] + + it "order-proof" $ runDb $ do + let p1 = Person "Zacarias" 93 Nothing + p1k <- insert p1 + escape <- getEscape + let query = T.concat [ "SELECT ?? " + , "FROM ", escape "Person" + ] + ret1 <- rawSql query [] + ret2 <- rawSql query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)] + liftIO $ ret1 @?= [Entity p1k p1] + liftIO $ ret2 @?= [Entity (RFOKey $ unPersonKey p1k) (RFO p1)] + + it "permits prefixes" $ runDb $ do + let r1 = Relationship "Foo" Nothing + r1k <- insert r1 + let r2 = Relationship "Bar" (Just r1k) + r2k <- insert r2 + let r3 = Relationship "Lmao" (Just r1k) + r3k <- insert r3 + let r4 = Relationship "Boring" (Just r2k) + r4k <- insert r4 + escape <- getEscape + let query = T.concat + [ "SELECT ??, ?? " + , "FROM ", escape "Relationship", " AS parent " + , "LEFT OUTER JOIN ", escape "Relationship", " AS child " + , "ON parent.id = child.parent" + ] + + result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <- + rawSql query [] + + liftIO $ + coerce result `shouldMatchList` + [ (Entity r1k r1, Just (Entity r2k r2)) + , (Entity r1k r1, Just (Entity r3k r3)) + , (Entity r2k r2, Just (Entity r4k r4)) + , (Entity r3k r3, Nothing) + , (Entity r4k r4, Nothing) + ] + + + it "OUTER JOIN" $ runDb $ do + let insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m) + => val -> ReaderT backend m (Key val, val) + insert' v = insert v >>= \k -> return (k, v) + (p1k, p1) <- insert' $ Person "Mathias" 23 Nothing + (p2k, p2) <- insert' $ Person "Norbert" 44 Nothing + (a1k, a1) <- insert' $ Pet p1k "Rodolfo" Cat + (a2k, a2) <- insert' $ Pet p1k "Zeno" Cat + escape <- getEscape + let query = T.concat [ "SELECT ??, ?? " + , "FROM ", person + , "LEFT OUTER JOIN ", pet + , " ON ", person, ".", escape "id" + , " = ", pet, ".", escape "ownerId" + , " ORDER BY ", person, ".", escape "name" + , ", ", pet, ".", escape "id" ] + person = escape "Person" + pet = escape "Pet" + ret <- rawSql query [] + liftIO $ ret @?= [ (Entity p1k p1, Just (Entity a1k a1)) + , (Entity p1k p1, Just (Entity a2k a2)) + , (Entity p2k p2, Nothing) ] + + it "commit/rollback" $ do + caseCommitRollback runDb + runDb cleanDB + + it "queries with large number of results" $ runDb $ do + -- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples + -- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369 + ret <- rawSql "SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" $ map PersistInt64 [1..15] + liftIO $ ret @?= [(Single (1::Int), Single (2::Int), Single (3::Int), Single (4::Int), Single (5::Int), Single (6::Int), Single (7::Int), Single (8::Int), Single (9::Int), Single (10::Int), Single (11::Int), Single (12::Int), Single (13::Int), Single (14::Int), Single (15::Int))] + + it "can handle a question mark in a string" $ runDb $ do + [Single ret] <- rawSql "SELECT 'hello\\?'" [] + liftIO $ + ret @== ("hello?" :: Text) + + describe "rawQuery" $ do + let conduitToList c = C.runConduitRes $ c C..| C.sinkList + it "handles question marks in a string literal" $ do + runDb $ do + [[PersistText result]] <- + conduitToList $ rawQuery "SELECT 'hello?'" [] + liftIO $ + result @== "hello?" + it "handles lower casing" $ + runDb $ do + void $ conduitToList $ rawQuery "SELECT full_name from lower_case_table WHERE my_id=5" [] + void $ conduitToList $ rawQuery "SELECT something_else from ref_table WHERE id=4" [] + getEscape :: MonadReader SqlBackend m => m (Text -> Text) getEscape = getEscapeRawNameFunction