1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies #-}
{-# LANGUAGE EmptyDataDecls, FlexibleContexts, GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
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
UniquePerson name
|]
data App = App
{ appConfig :: SqliteConf
, appPool :: ConnectionPool
}
mkYesod "App" [parseRoutes|
/ HomeR GET
/ins InsertR 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
getInsertR :: Handler ()
getInsertR = runDB $ insert400_ $ Person "Alice"
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 = do
test "streaming" $ do
sres <- request defaultRequest
assertBody "Alice\nBob\nCharlie\n" sres
assertStatus 200 sres
test "insert400" $ do
sres <- request defaultRequest
assertStatus 200 sres
sres' <- request $ defaultRequest `setPath` "/ins"
assertStatus 400 sres'
|
