Merge pull request #30 from parsonsmatt/matt/fix-selectSource

release key with selectSource

.travis.yml

@@ -32,6 +32,7 @@ script:
   - stack build
   - stack test --flag esqueleto:postgresql
   - stack test --flag esqueleto:-mysql
+  - stack test
 
 cache:
   directories:

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.

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