Yesod Persistent 使用 Aeson 将 UTCTime 解析为记录

Yesod Persistent using Aeson to parse UTCTime into record

我有来自 models.persistentmodels

的模型
...

Thing
    title Text
    price Int 
    kosher Bool
    optionalstuff [Text] Maybe
    createdat UTCTime
    updatedat UTCTime
    deriving Show

...

包含两个时间字段,分别是UTCTime

我通过 AJAX 收到 almost Thing,在 JSON。但是用户 JSON 不应该有 createdatupdatedatkosher。所以我们需要填写它们。

postNewEventR = do
    inputjson <- requireCheckJsonBody :: Handler Value
...
    -- get rawstringofthings from inputjson
...

    let objectsMissingSomeFields = case (decode (BL.fromStrict $ TE.encodeUtf8 rawstringofthings) :: Maybe [Object]) of
                        Nothing -> error "Failed to get a list of raw objects."
                        Just x  -> x

    now <- liftIO getCurrentTime

    -- Solution needs to go here:
    let objectsWithAllFields = objectsMissingSomeFields

    -- We hope to be done
    let things = case (eitherDecode $ encode objectsWithAllFields) :: Either String [Thing] of
                        Left err -> error $ "Failed to get things because: " <> err
                        Right xs  -> xs

这里出现错误"Failed to get things"是因为我们解析的JSON对象缺少模型中需要的字段。

解决方案

let objectsWithAllFields = Import.map (tackOnNeccessaryThingFields now True) objectsMissingSomeFields

所以我们获取当前对象并添加缺失的字段,例如koshercreatedat.

但是 UTCTime readaeson's way to parse UTCTime 的方式有一些奇怪的区别。因此,当我将 UTCTime 打印到 Aeson String 时,我需要将 UTCTime 打印成它稍后期望的格式:

tackOnNeccessaryThingFields :: UTCTime -> Bool -> Object -> Object
tackOnNeccessaryThingFields t b hm = G.fromList $ (G.toList hm) <> [
                                                                              ("createdat", String (pack $ formatTime defaultTimeLocale "%FT%T%QZ" t)),
                                                                              ("updatedat", String (pack $ formatTime defaultTimeLocale "%FT%T%QZ" t)),
                                                                              ("kosher", Bool b)
                                                                 ]

tackOnNeccessaryThingFields _ _ _ = error "This isn't an object."

此修复后,对象具有创建记录所需的所有字段,因此代码给出 [Thing]。 而且代码运行时没有运行时错误,而不是无法将 tshow t 解析为 UTCTime。

注意: This aeson github issue about this problem seems to closed but it seems not any more permissive: https://github.com/bos/aeson/issues/197

感谢 Artyom: https://artyom.me/aeson#records-and-json-generics

感谢 Pbrisbin: https://pbrisbin.com/posts/writing_json_apis_with_yesod/

感谢 Snoyman: 对于一切