comment out '

solution', add repro to test suite
This commit is contained in:
Matt Parsons 2017-06-21 11:25:56 -06:00
parent 2fa9760d51
commit e330f3326f
2 changed files with 49 additions and 6 deletions

View File

@ -53,7 +53,7 @@ module Database.Esqueleto.Internal.Sql
import Control.Arrow ((***), first) import Control.Arrow ((***), first)
import Control.Exception (throw, throwIO) 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.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadResource, release) import Control.Monad.Trans.Resource (MonadResource, release)
@ -782,11 +782,14 @@ selectSource :: ( SqlSelect a r
, MonadResource m ) , MonadResource m )
=> SqlQuery a => SqlQuery a
-> C.Source (SqlPersistT m) r -> C.Source (SqlPersistT m) r
selectSource query = do -- selectSource query = do
res <- lift $ rawSelectSource SELECT query -- res <- lift $ rawSelectSource SELECT query
(key, src) <- lift $ allocateAcquire res -- (key, src) <- lift $ allocateAcquire res
src -- src
lift $ release key -- lift $ release key
selectSource query = join . lift $ do
res <- rawSelectSource SELECT query
snd <$> allocateAcquire res
-- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s
-- 'SqlPersistT' monad and return a list of rows. -- 'SqlPersistT' monad and return a list of rows.

View File

@ -44,6 +44,8 @@ import Database.Sqlite (SqliteException)
import Database.Persist.TH import Database.Persist.TH
import Test.Hspec import Test.Hspec
import Data.Conduit (($$), Source, (=$=))
import qualified Data.Conduit.List as CL
import qualified Control.Monad.Trans.Resource as R import qualified Control.Monad.Trans.Resource as R
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Set as S import qualified Data.Set as S
@ -168,6 +170,44 @@ main = do
ret <- select $ return nothing ret <- select $ return nothing
liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] 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 describe "select/from" $ do
it "works for a simple example" $ it "works for a simple example" $
run $ do run $ do