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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
import SqliteInit
import qualified CompositeTest
import qualified CustomPersistFieldTest
import qualified CustomPrimaryKeyReferenceTest
import qualified DataTypeTest
import qualified EmbedOrderTest
import qualified EmbedTest
import qualified EmptyEntityTest
import qualified EquivalentTypeTest
import qualified ForeignKey
import qualified GeneratedColumnTestSQL
import qualified HtmlTest
import qualified LargeNumberTest
import qualified LongIdentifierTest
import qualified MaxLenTest
import qualified MaybeFieldDefsTest
import qualified MigrationColumnLengthTest
import qualified MigrationOnlyTest
import qualified MpsCustomPrefixTest
import qualified MpsNoPrefixTest
import qualified PersistUniqueTest
import qualified PersistentTest
import qualified PrimaryTest
import qualified RawSqlTest
import qualified ReadWriteTest
import qualified Recursive
import qualified RenameTest
import qualified SumTypeTest
import qualified TransactionLevelTest
import qualified TypeLitFieldDefsTest
import qualified UniqueTest
import qualified UpsertTest
import Control.Exception (IOException, handle, throwIO)
import Control.Monad.Catch (catch)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString as BS
import Data.Conduit (runConduit, (.|))
import qualified Data.Conduit.List as CL
import Data.Fixed
import Data.IntMap (IntMap)
import qualified Data.Text as T
import Data.Time
import Filesystem (removeFile)
import Filesystem.Path.CurrentOS (fromText)
import qualified Lens.Micro as Lens
import System.IO (hClose)
import System.IO.Temp (withSystemTempFile)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Database.Persist.Sqlite
import qualified Database.Sqlite as Sqlite
import PersistentTestModels
import qualified Database.Persist.Sqlite.CompositeSpec as CompositeSpec
import qualified MigrationTest
type Tuple = (,)
-- Test lower case names
share [mkPersist persistSettings, mkMigrate "dataTypeMigrate"] [persistLowerCase|
DataTypeTable no-json
text Text
textMaxLen Text maxlen=100
bytes ByteString
bytesTextTuple (Tuple ByteString Text)
bytesMaxLen ByteString maxlen=100
int Int
intList [Int]
intMap (IntMap Int)
double Double
bool Bool
day Day
pico Pico
time TimeOfDay
utc UTCTime
|]
share [mkPersist sqlSettings, mkMigrate "idSetup"] [persistLowerCase|
Simple
text Text
deriving Show Eq
SimpleReference
simpleCompositeId SimpleId
text Text
deriving Show Eq
|]
share [mkPersist sqlSettings, mkMigrate "idMigrateTest"] [persistLowerCase|
Simple2 sql=simple
text Text
int Int default=0
deriving Show Eq
SimpleReference2 sql=simple_reference
simpleCompositeId Simple2Id
text Text
deriving Show Eq
|]
instance Arbitrary DataTypeTable where
arbitrary = DataTypeTable
<$> arbText -- text
<*> (T.take 100 <$> arbText) -- textManLen
<*> arbitrary -- bytes
<*> liftA2 (,) arbitrary arbText -- bytesTextTuple
<*> (BS.take 100 <$> arbitrary) -- bytesMaxLen
<*> arbitrary -- int
<*> arbitrary -- intList
<*> arbitrary -- intMap
<*> arbitrary -- double
<*> arbitrary -- bool
<*> arbitrary -- day
<*> arbitrary -- pico
<*> (truncateTimeOfDay =<< arbitrary) -- time
<*> (truncateUTCTime =<< arbitrary) -- utc
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Test
time UTCTime
|]
setup :: MonadIO m => Migration -> ReaderT SqlBackend m ()
setup migration = do
printMigration migration
runMigrationUnsafe migration
main :: IO ()
main = do
handle (\(_ :: IOException) -> return ())
$ removeFile $ fromText sqlite_database_file
runConn $ do
mapM_ setup
[ ForeignKey.compositeMigrate
, PersistentTest.testMigrate
, PersistentTest.noPrefixMigrate
, PersistentTest.customPrefixMigrate
, EmbedTest.embedMigrate
, EmbedOrderTest.embedOrderMigrate
, LargeNumberTest.numberMigrate
, UniqueTest.uniqueMigrate
, MaxLenTest.maxlenMigrate
, MaybeFieldDefsTest.maybeFieldDefMigrate
, TypeLitFieldDefsTest.typeLitFieldDefsMigrate
, Recursive.recursiveMigrate
, CompositeTest.compositeMigrate
, MigrationTest.migrationMigrate
, PersistUniqueTest.migration
, RenameTest.migration
, CustomPersistFieldTest.customFieldMigrate
, PrimaryTest.migration
, CustomPrimaryKeyReferenceTest.migration
, MigrationColumnLengthTest.migration
, TransactionLevelTest.migration
, LongIdentifierTest.migration
]
PersistentTest.cleanDB
ForeignKey.cleanDB
hspec $ do
describe "Database" $ describe "Persist" $ describe "Sqlite" $ do
CompositeSpec.spec
RenameTest.specsWith db
DataTypeTest.specsWith
db
(Just (runMigrationSilent dataTypeMigrate))
[ TestFn "text" dataTypeTableText
, TestFn "textMaxLen" dataTypeTableTextMaxLen
, TestFn "bytes" dataTypeTableBytes
, TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
, TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
, TestFn "int" dataTypeTableInt
, TestFn "intList" dataTypeTableIntList
, TestFn "intMap" dataTypeTableIntMap
, TestFn "bool" dataTypeTableBool
, TestFn "day" dataTypeTableDay
, TestFn "time" (DataTypeTest.roundTime . dataTypeTableTime)
, TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)
]
[ ("pico", dataTypeTablePico) ]
dataTypeTableDouble
HtmlTest.specsWith
db
(Just (runMigrationSilent HtmlTest.htmlMigrate))
EmbedTest.specsWith db
EmbedOrderTest.specsWith db
LargeNumberTest.specsWith db
UniqueTest.specsWith db
MaxLenTest.specsWith db
MaybeFieldDefsTest.specsWith db
TypeLitFieldDefsTest.specsWith db
Recursive.specsWith db
SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
MigrationOnlyTest.specsWith db
(Just
$ runMigrationSilent MigrationOnlyTest.migrateAll1
>> runMigrationSilent MigrationOnlyTest.migrateAll2
)
PersistentTest.specsWith db
PersistentTest.filterOrSpecs db
ReadWriteTest.specsWith db
RawSqlTest.specsWith db
UpsertTest.specsWith
db
UpsertTest.Don'tUpdateNull
UpsertTest.UpsertPreserveOldKey
MpsNoPrefixTest.specsWith db
MpsCustomPrefixTest.specsWith db
EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))
CompositeTest.specsWith db
PersistUniqueTest.specsWith db
PrimaryTest.specsWith db
CustomPersistFieldTest.specsWith db
CustomPrimaryKeyReferenceTest.specsWith db
MigrationColumnLengthTest.specsWith db
EquivalentTypeTest.specsWith db
ForeignKey.specsWith db
TransactionLevelTest.specsWith db
MigrationTest.specsWith db
LongIdentifierTest.specsWith db
GeneratedColumnTestSQL.specsWith db
it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
void $ runMigrationSilent migrateAll
insert_ . Test $ read "2014-11-30 05:15:25.123Z"
[Single x] <- rawSql "select strftime('%s%f',time) from test" []
liftIO $ x `shouldBe` Just ("141732452525.123" :: String)
it "issue #339" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
void $ runMigrationSilent migrateAll
now <- liftIO getCurrentTime
tid <- insert $ Test now
Just (Test now') <- get tid
liftIO $ now' `shouldBe` now
it "issue #564" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do
hClose h
conn <- Sqlite.open (T.pack fp)
Sqlite.close conn
return ()
it "issue #527" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
void $ runMigrationSilent migrateAll
insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123Z")
it "afterException" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
void $ runMigrationSilent testMigrate
let catcher :: forall m. Monad m => SomeException -> m ()
catcher _ = return ()
insert_ $ Person "A" 0 Nothing
insert_ (Person "A" 1 Nothing) `catch` catcher
insert_ $ Person "B" 0 Nothing
return ()
|
