Store existing data-type with Yesod's Persistent

ε祈祈猫儿з 提交于 2019-12-04 19:32:54


All the tutorials and references that I could find about Persistent describe in great detail how Persistent can automatically create a new data-type, schema, migration, etc. out of a single definition in its DSL. However, I couldn't find an explanation on how to get Persistent to handle already existing data-types.

An example: Suppose I have an already existing Haskell module for some game logic. It includes a record type for a player. (It's meant to be used through lenses, hence the underscores.)

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

Question: What's the canonical way to store such a type in a data-base with Persistent? Is there some type-class that I can implement. Or should I best define a new type through Persistent, e.g.

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

and then manually map between these types?

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

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



{-# LANGUAGE TemplateHaskell #-}
module Employment where

import Database.Persist.TH

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

The derivePersistField function is the template Haskell magic that makes it work.

Note, you need to do the derivePersistField thing in a separate file to where you do the mkPersist to avoid a TH phase error.


My solution to this problem was to add a new type through Yesod's mkPersist, and manually marshal between those.


    name Text
    points Int
    created UTCTime default=CURRENT_TIMESTAMP


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

One possible advantage is that you can have fields in your table, that are not required in the internal record. In my example, it was useful to attach a creation date to the player. However, this was only used in the web-interface layer, it was never used in the internal game logic, which defined the Player type. However, due to the manual marshalling I could add that field to the same database table nonetheless.