如何让默认值来自数据库？

Question

为什么user对象仍具有Nothing用于createdAt和updatedAt？为什么这些字段没有被数据库分配？

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
  email String
  createdAt UTCTime Maybe default=CURRENT_TIME
  updatedAt UTCTime Maybe default=CURRENT_TIME
  deriving Show
|]

main = runSqlite ":memory:" $ do
  runMigration migrateAll
  userId <- insert $ User "saurabhnanda@gmail.com" Nothing Nothing
  liftIO $ print userId
  user <- get userId
  case user of
    Nothing -> liftIO $ putStrLn ("coulnt find userId=" ++ (show userId))
    Just u -> liftIO $ putStrLn ("user=" ++ (show user))

输出:

UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}
user=Just (User {userEmail = "saurabhnanda@gmail.com", userCreatedAt = Nothing, userUpdatedAt = Nothing})

Answer 1

（编辑：请参见下面使用触发器的解决方案）

问题：默认值不会覆盖将列显式设置为NULL的问题

根据SQLite文档：

如果用户在执行INSERT时未明确提供任何值，则DEFAULT子句指定用于该列的默认值。

问题是，当Persistent执行插入操作时，它将createdAt和updatedAt列指定为NULL：

[Debug#SQL] INSERT INTO "user"("email","created_at","updated_at") VALUES(?,?,?); [PersistText "saurabhnanda@gmail.com",PersistNull,PersistNull]

为了得出这个结论，我修改了您的代码片段以添加SQL日志记录（我只是复制了runSqlite它的源并将其更改为记录到STDOUT）。我只是使用文件而不是内存数据库，因此可以在SQLite编辑器中打开数据库并验证是否设置了默认值。

-- Pragmas and imports are taken from a snippet in the Yesod book. Some of them may be superfluous.
{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Control.Monad.IO.Class (liftIO)
import Data.Time
import Control.Monad.Trans.Resource
import Control.Monad.Logger
import Control.Monad.IO.Class
import Data.Text

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
  email String
  createdAt UTCTime Maybe default=CURRENT_TIME
  updatedAt UTCTime Maybe default=CURRENT_TIME
  deriving Show
|]

runSqlite2 :: (MonadBaseControl IO m, MonadIO m)
          => Text -- ^ connection string
          -> SqlPersistT (LoggingT (ResourceT m)) a -- ^ database action
          -> m a
runSqlite2 connstr = runResourceT
                  . runStdoutLoggingT
                  . withSqliteConn connstr
                  . runSqlConn

main = runSqlite2 "bar.db" $ do
  runMigration migrateAll
  userId <- insert $ User "saurabhnanda@gmail.com" Nothing Nothing
  liftIO $ print userId
  user <- get userId
  case user of
    Nothing -> liftIO $ putStrLn ("coulnt find userId=" ++ (show userId))
    Just u -> liftIO $ putStrLn ("user=" ++ (show user))

这是我得到的输出：

Max@maximilians-mbp /tmp> stack runghc sqlite.hs
Run from outside a project, using implicit global project config
Using resolver: lts-3.10 from implicit global project's config file: /Users/Max/.stack/global/stack.yaml
Migrating: CREATE TABLE "user"("id" INTEGER PRIMARY KEY,"email" VARCHAR NOT NULL,"created_at" TIMESTAMP NULL DEFAULT CURRENT_TIME,"updated_at" TIMESTAMP NULL DEFAULT CURRENT_TIME)
[Debug#SQL] CREATE TABLE "user"("id" INTEGER PRIMARY KEY,"email" VARCHAR NOT NULL,"created_at" TIMESTAMP NULL DEFAULT CURRENT_TIME,"updated_at" TIMESTAMP NULL DEFAULT CURRENT_TIME); []
[Debug#SQL] INSERT INTO "user"("email","created_at","updated_at") VALUES(?,?,?); [PersistText "saurabhnanda@gmail.com",PersistNull,PersistNull]
[Debug#SQL] SELECT "id" FROM "user" WHERE _ROWID_=last_insert_rowid(); []
UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}
[Debug#SQL] SELECT "email","created_at","updated_at" FROM "user" WHERE "id"=? ; [PersistInt64 1]
user=Just (User {userEmail = "saurabhnanda@gmail.com", userCreatedAt = Nothing, userUpdatedAt = Nothing})

编辑：使用触发器的解决方案：

您可以使用触发器来实现created_at和updated_at列。这种方法有一些不错的优点。基本上，updated_at无论如何都无法通过DEFAULT值来强制执行，因此，如果要数据库（而不是应用程序）来管理它，则需要一个触发器。触发器还解决了updated_at在执行原始SQL查询或批处理更新时设置的问题。这是此解决方案的外观：

CREATE TRIGGER set_created_and_updated_at AFTER INSERT ON user
BEGIN
UPDATE user SET created_at=CURRENT_TIMESTAMP, updated_at=CURRENT_TIMESTAMP WHERE user.id = NEW.id;
END

CREATE TRIGGER set_updated_at AFTER UPDATE ON user
BEGIN
UPDATE user SET updated_at=CURRENT_TIMESTAMP WHERE user.id = NEW.id;
END

现在输出是预期的：

[Debug#SQL] INSERT INTO "user"("email","created_at","updated_at") VALUES(?,?,?); [PersistText "saurabhnanda@gmail.com",PersistNull,PersistNull]
[Debug#SQL] SELECT "id" FROM "user" WHERE _ROWID_=last_insert_rowid(); []
UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}
[Debug#SQL] SELECT "email","created_at","updated_at" FROM "user" WHERE "id"=? ; [PersistInt64 1]
user=Just (User {userEmail = "saurabhnanda@gmail.com", userCreatedAt = Just 2016-02-12 16:41:43 UTC, userUpdatedAt = Just 2016-02-12 16:41:43 UTC})

触发器解决方案的主要缺点是设置触发器有点麻烦。

编辑2：避免Maybe和Postgres支持

如果你想避免Maybe的价值观createdAt和updatedAt，你可以在服务器上设置他们，像这样一些虚拟的价值：

-- | Use 'zeroTime' to get a 'UTCTime' without doing any IO.
-- The main use case of this is providing a dummy-value for createdAt and updatedAt fields on our models. Those values are set by database triggers anyway.
zeroTime :: UTCTime
zeroTime = UTCTime (fromGregorian 1 0 0) (secondsToDiffTime 0)

然后让服务器通过触发器设置值。稍有hacky，但实际上效果很好。

PostgreSQL触发器

OP要求使用SQLite，但我敢肯定，人们也会在阅读其他数据库时使用。这是Postgresql版本：

CREATE OR REPLACE FUNCTION create_timestamps()   
        RETURNS TRIGGER AS $$
        BEGIN
            NEW.created_at = now();
            NEW.updated_at = now();
            RETURN NEW;   
        END;
        $$ language 'plpgsql';

CREATE OR REPLACE FUNCTION update_timestamps()   
        RETURNS TRIGGER AS $$
        BEGIN
            NEW.updated_at = now();
            RETURN NEW;   
        END;
        $$ language 'plpgsql';

CREATE TRIGGER users_insert BEFORE INSERT ON users FOR EACH ROW EXECUTE PROCEDURE create_timestamps();
CREATE TRIGGER users_update BEFORE UPDATE ON users FOR EACH ROW EXECUTE PROCEDURE update_timestamps();

Answer 2

根据http://www.yesodweb.com/book/persistent

默认属性对 Haskell 代码本身绝对没有影响；您仍然需要填写所有值。这只会影响数据库架构和自动迁移。

do
  time <- liftIO getCurrentTime
  insert $ User "saurabhnanda@gmail.com" time time