haskell - Yesod数据库迁移循环

Question

我正在运行 Yesod 并访问 MySQL 数据库。

我的模型是:

User
    ident Text
    password Text Maybe
    UniqueUser ident
    deriving Typeable
Email
    email Text
    userId UserId Maybe
    verkey Text Maybe
    UniqueEmail email
Comment json -- Adding "json" causes ToJSON and FromJSON instances to be derived.
    message Text
    userId UserId Maybe
    deriving Eq
    deriving Show

 -- By default this file is used in Model.hs (which is imported by Foundation.hs)

当我运行 Yesod 应用程序时，它会重复以下内容:

Starting devel application
Migrating: ALTER TABLE `user` ALTER COLUMN `password` DROP DEFAULT
28/Mar/2017:23:46:44 +0200 [Debug#SQL] ALTER TABLE `user` ALTER COLUMN `password` DROP DEFAULT; []
devel.hs: ConnectionError {errFunction = "query", errNumber = 1101, errMessage = "BLOB/TEXT column 'password' can't have a default value"}
Unexpected: child process exited with ExitFailure 1
Trying again
Starting devel application
Migrating: ALTER TABLE `user` ALTER COLUMN `password` DROP DEFAULT
28/Mar/2017:23:46:46 +0200 [Debug#SQL] ALTER TABLE `user` ALTER COLUMN `password` DROP DEFAULT; []
devel.hs: ConnectionError {errFunction = "query", errNumber = 1101, errMessage = "BLOB/TEXT column 'password' can't have a default value"}
Unexpected: child process exited with ExitFailure 1
Trying again

它进入永无止境的循环。

解决方法是注释 Application.hs 中的以下行，这意味着禁用数据库迁移:

runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc

但是如果我使用解决方法，我会收到另一个错误:

28/Mar/2017:23:56:28 +0200 [Error#yesod-core] Foundation.hs:(137,5)-(144,45): Non-exhaustive patterns in function isAuthorized
 @(yesod-core-1.4.32-6HthMZNCl0sEMRz6GJ4QO1:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:693:5)
28/Mar/2017:23:56:28 +0200 [Debug#SQL] SELECT `ident`,`password` FROM `user` WHERE `id`=? ; [PersistInt64 1]
GET /test
  Accept: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8
  Status: 500 Internal Server Error 0.006514s

Answer 1

将 default=NULL 添加到每个 Text Maybe 列可以解决此问题。在某些 MySQL 版本中，您还需要通过添加 sqltype=varchar(255) 来更改列类型。在您的情况下，模型应如下所示:

User
    ident Text
    password Text Maybe sqltype=varchar(255) default=NULL
    UniqueUser ident
    deriving Typeable
Email
    email Text
    userId UserId Maybe
    verkey Text Maybe sqltype=varchar(255) default=NULL
    UniqueEmail email
Comment json -- Adding "json" causes ToJSON and FromJSON instances to be derived.
    message Text
    userId UserId Maybe
    deriving Eq
    deriving Show

 -- By default this file is used in Model.hs (which is imported by Foundation.hs)