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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module MySQL.Test where
import Common.Test.Import hiding (from, on)
import Control.Applicative
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
import Control.Monad.Trans.Reader (ReaderT, mapReaderT)
import qualified Control.Monad.Trans.Resource as R
import Database.Esqueleto
import Database.Esqueleto.Experimental hiding (from, on)
import qualified Database.Esqueleto.Experimental as Experimental
import Database.Persist.MySQL
( connectDatabase
, connectHost
, connectPassword
, connectPort
, connectUser
, createMySQLPool
, defaultConnectInfo
, withMySQLConn
)
import Test.Hspec
import Common.Test
import Data.Maybe (fromMaybe)
import System.Environment (lookupEnv)
testMysqlSum :: SpecDb
testMysqlSum = do
itDb "works with sum_" $ do
_ <- insert' p1
_ <- insert' p2
_ <- insert' p3
_ <- insert' p4
ret <- select $
from $ \p->
return $ joinV $ sum_ (p ^. PersonAge)
liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ]
testMysqlTwoAscFields :: SpecDb
testMysqlTwoAscFields = do
itDb "works with two ASC fields (one call)" $ do
p1e <- insert' p1
p2e <- insert' p2
p3e <- insert' p3
p4e <- insert' p4
ret <- select $
from $ \p -> do
orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
return p
liftIO $ ret `shouldBe` [ p2e, p4e, p3e, p1e ]
testMysqlOneAscOneDesc :: SpecDb
testMysqlOneAscOneDesc = do
itDb "works with one ASC and one DESC field (two calls)" $ do
p1e <- insert' p1
p2e <- insert' p2
p3e <- insert' p3
p4e <- insert' p4
ret <- select $
from $ \p -> do
orderBy [desc (p ^. PersonAge)]
orderBy [asc (p ^. PersonName)]
return p
liftIO $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
testMysqlCoalesce :: SpecDb
testMysqlCoalesce = do
itDb "works on PostgreSQL and MySQL with <2 arguments" $ do
_ :: [Value (Maybe Int)] <-
select $
from $ \p -> do
return (coalesce [p ^. PersonAge])
return ()
testMysqlUpdate :: SpecDb
testMysqlUpdate = do
itDb "works on a simple example" $ do
p1k <- insert p1
p2k <- insert p2
p3k <- insert p3
let anon = "Anonymous"
() <- update $ \p -> do
set p [ PersonName =. val anon
, PersonAge *=. just (val 2) ]
where_ (p ^. PersonName !=. val "Mike")
n <- updateCount $ \p -> do
set p [ PersonAge +=. just (val 1) ]
where_ (p ^. PersonName !=. val "Mike")
ret <- select $
from $ \p -> do
orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
return p
-- MySQL: nulls appear first, and update returns actual number
-- of changed rows
liftIO $ n `shouldBe` 1
liftIO $ ret `shouldBe` [ Entity p2k (Person anon Nothing (Just 37) 2)
, Entity p1k (Person anon (Just 73) Nothing 1)
, Entity p3k p3 ]
nameContains :: (SqlString s)
=> (SqlExpr (Value [Char])
-> SqlExpr (Value s)
-> SqlExpr (Value Bool))
-> s
-> [Entity Person]
-> SqlPersistT IO ()
nameContains f t expected = do
ret <- select $
from $ \p -> do
where_ (f
(p ^. PersonName)
(concat_ [(%), val t, (%)]))
orderBy [asc (p ^. PersonName)]
return p
liftIO $ ret `shouldBe` expected
testMysqlTextFunctions :: SpecDb
testMysqlTextFunctions = do
describe "text functions" $ do
itDb "like, (%) and (++.) work on a simple example" $ do
[p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
nameContains like "h" [p1e, p2e]
nameContains like "i" [p4e, p3e]
nameContains like "iv" [p4e]
testMysqlUnionWithLimits :: SpecDb
testMysqlUnionWithLimits = do
describe "MySQL Union" $ do
itDb "supports limit/orderBy by parenthesizing" $ do
mapM_ (insert . Foo) [1..6]
let q1 = do
foo <- Experimental.from $ Table @Foo
where_ $ foo ^. FooName <=. val 3
orderBy [asc $ foo ^. FooName]
limit 2
pure $ foo ^. FooName
let q2 = do
foo <- Experimental.from $ Table @Foo
where_ $ foo ^. FooName >. val 3
orderBy [asc $ foo ^. FooName]
limit 2
pure $ foo ^. FooName
ret <- select $ Experimental.from $ q1 `union_` q2
liftIO $ ret `shouldMatchList` [Value 1, Value 2, Value 4, Value 5]
spec :: Spec
spec = beforeAll mkConnectionPool $ do
tests
describe "MySQL specific tests" $ do
-- definitely doesn't work at the moment
-- testMysqlRandom
testMysqlSum
testMysqlTwoAscFields
testMysqlOneAscOneDesc
testMysqlCoalesce
testMysqlUpdate
testMysqlTextFunctions
testMysqlUnionWithLimits
verbose :: Bool
verbose = False
migrateIt :: R.MonadUnliftIO m => SqlPersistT m ()
migrateIt = do
mapReaderT R.runResourceT $ void $ runMigrationSilent migrateAll
cleanDB
mkConnectionPool :: IO ConnectionPool
mkConnectionPool = do
ci <- isCI
mysqlHost <- (fromMaybe "localhost" <$> lookupEnv "MYSQL_HOST")
let connInfo
| ci =
defaultConnectInfo
{ connectHost = "127.0.0.1"
, connectUser = "travis"
, connectPassword = "esqutest"
, connectDatabase = "esqutest"
, connectPort = 33306
}
| otherwise =
defaultConnectInfo
{ connectHost = mysqlHost
, connectUser = "travis"
, connectPassword = "esqutest"
, connectDatabase = "esqutest"
, connectPort = 3306
}
pool <-
if verbose
then
runStderrLoggingT $
createMySQLPool connInfo 4
else
runNoLoggingT $
createMySQLPool connInfo 4
flip runSqlPool pool $ do
migrateIt
cleanDB
pure pool
|
