使用 Yesod 的 Persistent 存储现有数据类型答案

【问题标题】：Store existing data-type with Yesod's Persistent使用 Yesod 的 Persistent 存储现有数据类型
【发布时间】：2015-03-23 23:56:59
【问题描述】：

我能找到的所有关于 Persistent 的教程和参考资料都非常详细地描述了 Persistent 如何从其 DSL 中的单个定义中自动创建新的数据类型、模式、迁移等。但是，我找不到关于如何让 Persistent 处理已经存在的数据类型的解释。

一个例子：假设我已经有一个用于某些游戏逻辑的 Haskell 模块。它包括玩家的记录类型。（它意味着通过镜头使用，因此有下划线。）

data Player = Player { _name   :: String
                     , _points :: Int
                     -- more fields ...
                     }
$(makeLenses ''Player)

问题：使用 Persistent 将这种类型存储在数据库中的规范方法是什么？是否有一些我可以实现的类型类。还是我最好通过 Persistent 定义一个新类型，例如

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
PlayerEntry
    name Text
    points Int
|]

然后在这些类型之间手动映射？

playerToEntry :: Player -> PlayerEntry
playerToEntry pl = PlayerEntry (pl^.name) (pl^.points)

entryToPlayer :: PlayerEntry -> Player
entryToPlayer e = Player (name e) (points e)

【问题讨论】：

你认为手动定义像this这样的字段有意义吗？
@ace 当然，您可以手动生成 mkPersist 为您生成的所有代码。我最初发布了这个问题，因为我没有找到一个地方可以很好地记录如何做到这一点。但是，事实证明我实际上需要在表格中添加额外的列。因此，在我的案例中，两种类型之间的编组被证明是一个很好的解决方案。

标签： haskell yesod persistent

【解决方案1】：

发件人：http://www.yesodweb.com/book/persistent

{-# LANGUAGE TemplateHaskell #-}
module Employment where

import Database.Persist.TH

data Employment = Employed | Unemployed | Retired
    deriving (Show, Read, Eq)
derivePersistField "Employment"

derivePersistField 函数是模板 Haskell 的魔力，使它工作。

注意，您需要在一个单独的文件中执行 derivePersistField 的操作，而不是执行 mkPersist 以避免 TH 相位错误。

【讨论】：

感谢您的回答。不幸的是，这并不是我想要的。 derivePersistField 将为表的 column 生成一个类型。但是，我需要一个 整个表 的类型。在我的情况下，我解决它的方法是生成一个新类型，如上面的PlayerEntry，然后在Player 和PlayerEntry 之间手动编组。对于我的类型中的一些字段，我使用derivePersistField 来生成相应的列。我想我应该在这里的答案中写下来。
我想看看你是怎么做到的@Lemming。我也在努力为这个问题找到一个好的解决方案，并因此强烈考虑放弃持久化。
@ace 根据要求，我添加了我的解决方案。

【解决方案2】：

我对这个问题的解决方案是通过 Yesod 的 mkPersist 添加一个新类型，并在它们之间手动编组。

config/models:

PlayerEntry
    name Text
    points Int
    created UTCTime default=CURRENT_TIMESTAMP

Marshalling.hs:

fromPlayerEntry :: PlayerEntry -> Player
fromPlayerEntry PlayerEntry {..} = Player { name = playerName
                                          , points = playerPoints
                                          }

createPlayerEntry :: Text -> YesodDB App (Entity PlayerEntry)
createPlayerEntry name = do
    currentTime <- liftIO getCurrentTime
    let player = PlayerEntry { playerName = name
                             , playerPoints = 0
                             , playerCreated = currentTime
                             }
    playerId <- insert player
    return $ Entity playerId player

updatePlayerEntry :: PlayerEntryId -> Player -> YesodDB App ()
updatePlayerEntry playerId Player {..} =
    update playerId [ PlayerName =. name
                    , PlayerPoints =. points
                    ]

一个可能的优势是您可以在表中包含内部记录中不需要的字段。在我的示例中，将创建日期附加到播放器很有用。但是，这只是在 web-interface 层使用，它从未用于定义 Player 类型的内部游戏逻辑。但是，由于手动编组，我仍然可以将该字段添加到同一个数据库表中。

【讨论】：