8b2297adf4
Pinging @gregwebs. I've backported the relevant tweaks on the yesod-1.4 branch, to allow master to compile against persistent2. Whenever you're ready to release persistent2, we can: 1. Release persistent2. 2. Release new versions of yesod packages, which will work with persistent 1.3 and 2.0. 3. Add an upper bound in Stackage to avoid using the new persistent libraries until they're ready for primetime. 4. Release your blog post. yesod-1.4 should then remove the CPP here and only work with persistent2; the biggest "breaking change" in the 1.4 release will be remove backwards compatibility hacks for persistent, conduit, shakespeare, and wai.
63 lines
1.7 KiB
Haskell
63 lines
1.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-}
|
|
{-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
module Yesod.PersistSpec where
|
|
|
|
import Test.Hspec
|
|
import Database.Persist.Sqlite
|
|
import Network.Wai.Test
|
|
import Yesod.Core
|
|
import Data.Conduit
|
|
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
|
import Yesod.Persist
|
|
import Data.Text (Text)
|
|
|
|
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
|
|
Person
|
|
name Text
|
|
|]
|
|
|
|
data App = App
|
|
{ appConfig :: SqliteConf
|
|
, appPool :: ConnectionPool
|
|
}
|
|
|
|
mkYesod "App" [parseRoutes|
|
|
/ HomeR GET
|
|
|]
|
|
|
|
instance Yesod App
|
|
instance YesodPersist App where
|
|
type YesodPersistBackend App = SqlBackend
|
|
runDB = defaultRunDB appConfig appPool
|
|
instance YesodPersistRunner App where
|
|
getDBRunner = defaultGetDBRunner appPool
|
|
|
|
getHomeR :: Handler TypedContent
|
|
getHomeR = do
|
|
runDB $ do
|
|
runMigration migrateAll
|
|
deleteWhere ([] :: [Filter Person])
|
|
insert_ $ Person "Charlie"
|
|
insert_ $ Person "Alice"
|
|
insert_ $ Person "Bob"
|
|
respondSourceDB typePlain $ selectSource [] [Asc PersonName] $= awaitForever toBuilder
|
|
where
|
|
toBuilder (Entity _ (Person name)) = do
|
|
yield $ Chunk $ fromText name
|
|
yield $ Chunk $ fromText "\n"
|
|
yield Flush
|
|
|
|
test :: String -> Session () -> Spec
|
|
test name session = it name $ do
|
|
let config = SqliteConf ":memory:" 1
|
|
pool <- createPoolConfig config
|
|
app <- toWaiApp $ App config pool
|
|
runSession session app
|
|
|
|
spec :: Spec
|
|
spec = test "streaming" $ do
|
|
sres <- request defaultRequest
|
|
assertBody "Alice\nBob\nCharlie\n" sres
|
|
assertStatus 200 sres
|