From 2fa9760d510defc50e99b31d3aa91e498cbf7618 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 11:09:37 -0600 Subject: [PATCH 1/6] release key --- src/Database/Esqueleto/Internal/Sql.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) 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. From e330f3326f1f818dc2da6e4f7b5887e5291bde8c Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 11:25:56 -0600 Subject: [PATCH 2/6] comment out ' solution', add repro to test suite --- src/Database/Esqueleto/Internal/Sql.hs | 15 ++++++---- test/Test.hs | 40 ++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 6 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index ec4578e..2f46ad0 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -53,7 +53,7 @@ module Database.Esqueleto.Internal.Sql import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) -import Control.Monad (ap, MonadPlus(..), void) +import Control.Monad (ap, MonadPlus(..), void, join) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource, release) @@ -782,11 +782,14 @@ selectSource :: ( SqlSelect a r , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r -selectSource query = do - res <- lift $ rawSelectSource SELECT query - (key, src) <- lift $ allocateAcquire res - src - lift $ release key +-- selectSource query = do +-- res <- lift $ rawSelectSource SELECT query +-- (key, src) <- lift $ allocateAcquire res +-- src +-- lift $ release key +selectSource query = join . lift $ do + res <- rawSelectSource SELECT query + snd <$> allocateAcquire res -- | 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 From 338f5a3c47ceedd0a981a2ce378ae975aad617af Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 11:26:47 -0600 Subject: [PATCH 3/6] fixes the test failure --- src/Database/Esqueleto/Internal/Sql.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 2f46ad0..ad6d833 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -782,14 +782,14 @@ selectSource :: ( SqlSelect a r , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r --- selectSource query = do --- res <- lift $ rawSelectSource SELECT query --- (key, src) <- lift $ allocateAcquire res --- src --- lift $ release key -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 +-- selectSource query = join . lift $ do +-- res <- rawSelectSource SELECT query +-- snd <$> allocateAcquire res -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a list of rows. From 28ceb892eb7afb61452d85e8a35f729fec511df2 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 11:28:46 -0600 Subject: [PATCH 4/6] remove comment --- src/Database/Esqueleto/Internal/Sql.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index ad6d833..65b62dd 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -787,9 +787,6 @@ selectSource query = do (key, src) <- lift $ allocateAcquire res src lift $ release key --- selectSource query = join . lift $ do --- res <- rawSelectSource SELECT query --- snd <$> allocateAcquire res -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a list of rows. From 6a435f53b4f966326e87c22b76cae10e957d760c Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 11:46:38 -0600 Subject: [PATCH 5/6] redundant import --- src/Database/Esqueleto/Internal/Sql.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 65b62dd..ec4578e 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -53,7 +53,7 @@ module Database.Esqueleto.Internal.Sql import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) -import Control.Monad (ap, MonadPlus(..), void, join) +import Control.Monad (ap, MonadPlus(..), void) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource, release) From 40c966bc75472854ec070e30c3b0577ff93c7c94 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Wed, 21 Jun 2017 12:23:24 -0600 Subject: [PATCH 6/6] add stack test --- .travis.yml | 1 + 1 file changed, 1 insertion(+) 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: