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

Store existing data-type with Yesod's Persistent

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

一个例子:假设我有一个已经存在的Haskell模块用于一些游戏逻辑。它包括播放器的记录类型。 (它意味着要通过镜头使用,因此有下划线。)

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

问题:使用 Persistent 在数据库中存储这种类型的规范方法是什么?有没有我可以实现的类型-class。或者我最好通过 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)

发件人: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 阶段错误。

我对这个问题的解决方案是通过 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
                    ]

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