diff --git a/.travis.yml b/.travis.yml index 737604e..5525102 100644 --- a/.travis.yml +++ b/.travis.yml @@ -32,6 +32,7 @@ script: - stack build - stack test --flag esqueleto:postgresql - stack test --flag esqueleto:-mysql + - stack test cache: directories: diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index fe0c66a..ec4578e 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -53,10 +53,10 @@ module Database.Esqueleto.Internal.Sql import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) -import Control.Monad (ap, MonadPlus(..), join, void) +import Control.Monad (ap, MonadPlus(..), void) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Resource (MonadResource) +import Control.Monad.Trans.Resource (MonadResource, release) import Data.Acquire (with, allocateAcquire, Acquire) import Data.Int (Int64) import Data.List (intersperse) @@ -782,9 +782,11 @@ selectSource :: ( SqlSelect a r , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r -selectSource query = join . lift $ do - res <- rawSelectSource SELECT query - snd <$> allocateAcquire res +selectSource query = do + res <- lift $ rawSelectSource SELECT query + (key, src) <- lift $ allocateAcquire res + src + lift $ release key -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a list of rows. diff --git a/test/Test.hs b/test/Test.hs index 0df1cb0..28aaf77 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -44,6 +44,8 @@ import Database.Sqlite (SqliteException) import Database.Persist.TH import Test.Hspec +import Data.Conduit (($$), Source, (=$=)) +import qualified Data.Conduit.List as CL import qualified Control.Monad.Trans.Resource as R import qualified Data.List as L import qualified Data.Set as S @@ -168,6 +170,44 @@ main = do ret <- select $ return nothing liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] + describe "selectSource" $ do + it "works for a simple example" $ + run $ do + let query = selectSource $ + from $ \person -> + return person + p1e <- insert' p1 + ret <- query $$ CL.consume + liftIO $ ret `shouldBe` [ p1e ] + + it "can run a query many times" $ + run $ do + let query = selectSource $ + from $ \person -> + return person + p1e <- insert' p1 + ret0 <- query $$ CL.consume + ret1 <- query $$ CL.consume + liftIO $ ret0 `shouldBe` [ p1e ] + liftIO $ ret1 `shouldBe` [ p1e ] + + it "works on repro" $ do + let selectPerson :: R.MonadResource m => String -> Source (SqlPersistT m) (Key Person) + selectPerson name = do + let source = selectSource $ from $ \person -> do + where_ $ person ^. PersonName ==. val name + return $ person ^. PersonId + source =$= CL.map unValue + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + r1 <- selectPerson (personName p1) $$ CL.consume + r2 <- selectPerson (personName p2) $$ CL.consume + liftIO $ do + r1 `shouldBe` [ entityKey p1e ] + r2 `shouldBe` [ entityKey p2e ] + + describe "select/from" $ do it "works for a simple example" $ run $ do