在 fromJson 中插入默认时间戳答案

【问题标题】：Insert default timestamp in fromJson在 fromJson 中插入默认时间戳
【发布时间】：2017-08-01 17:25:00
【问题描述】：

我有一个 ajax 调用将 json 发送到 Yesod 中的路由，我希望该路由解析 json 并将其直接插入数据库。在我的模型文件中，我有

createtime UTCTime default=now()

这会阻止解析 json，因为客户端没有发送创建时间。我尝试为日志条目编写自己的 parseJson，但由于 getCurrentTime 在 IO monad 中返回一个值，因此我无法插入 UTCTime 默认值。如果可能，我希望数据库设置该值。

此时我唯一能想到的就是创建一个像 LogEntryWithoutTime 这样的类型，将 JSON 解析为该类型并转换为 LogEntry。有没有更简单的方法？

编辑： 我展示了将 getCurrentTime 添加到 JSON 解析的三种不同失败。首先，目的是解析创建时间（如果可用），默认为服务器上的 getCurrentTime。无论如何这都是不对的，因为我们不应该依赖客户的时间。

instance FromJSON Log where
    parseJSON (Object o) = Log
        <$> o .: "userid"
        ...
        <*> o .:? "createtime" .!= liftIO getCurrentTime

错误是

Model.hs:58:32:
Couldn't match expected type ‘UTCTime’
            with actual type ‘m0 UTCTime’
In the second argument of ‘(.!=)’, namely ‘liftIO getCurrentTime’
In the second argument of ‘(<*>)’, namely
  ‘o .:? "createtime" .!= liftIO getCurrentTime’

其次，我尝试获取当前时间。

<*> liftIO getCurrentTime

我得到了错误

Model.hs:58:9:
No instance for (MonadIO
                   aeson-0.7.0.6:Data.Aeson.Types.Internal.Parser)
  arising from a use of ‘liftIO’
In the second argument of ‘(<*>)’, namely ‘liftIO getCurrentTime’

如果我将行改为

<*> getCurrentTime

然后我得到

Model.hs:58:9:
Couldn't match type ‘IO’
              with ‘aeson-0.7.0.6:Data.Aeson.Types.Internal.Parser’
Expected type: aeson-0.7.0.6:Data.Aeson.Types.Internal.Parser
                 UTCTime
  Actual type: IO UTCTime

【问题讨论】：

你解决这个问题了吗？我现在正在为此苦苦挣扎。
抱歉，我找不到好的解决方案。

标签： haskell yesod aeson

【解决方案1】：

在模型中定义default 属性的事情是，在持久化实体时仍然需要定义所有值。据我所知，默认值仅用于自动迁移和架构定义。

尝试从 IO monad 中提升 getCurrentTime（使用 liftIO）。

【讨论】：

我看到模型文件不会影响 Haskell 代码，所以我最终编写了原始 SQL 来插入行。当我发布这个问题时，我尝试使用 liftIO 并且它不起作用，但我不记得确切的错误。我认为它试图将其放入另一个 monad，但没有其他 monad。
没有 (MonadIO aeson-0.8.0.2:Data.Aeson.Types.Internal.Parser) 的实例

【解决方案2】：

我现在面临着同样的问题。我目前的想法是，由于我不希望用户向我提供完整的记录，所以我不应该那样建模。相反，我应该对用户期望的请求正文进行建模，然后自己对其进行转换以进行存储。

所以，您可能有PartialLog 的概念，它只有您希望用户发送的字段：

data PartialLog = PartialLog { partialLogMessage :: Text }

那么你可能有一个功能可以填补空白并为你提供完整的记录：

{-# LANGUAGE RecordWildCards #-}

logFromPartial :: PartialLog -> UserId -> IO Log
logFromPartial p u = do
  let logUserId  = u
      logMessage = partialLogMessage p
  logCreatetime <- liftIO getCurrentTime
  return Log{..}

n.b. 我传入UserId 是因为我们可能希望该值来自经过身份验证的会话；用户无需告诉我们他们的 ID 是什么。

【讨论】：