Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Store existing data-type with Yesod's Persistent

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|
PlayerEntry
    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)
like image 990
Lemming Avatar asked Jan 25 '15 10:01

Lemming


2 Answers

From: 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"

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.

like image 102
Erik de Castro Lopo Avatar answered Oct 18 '22 15:10

Erik de Castro Lopo


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

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
                    ]

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.

like image 45
Lemming Avatar answered Oct 18 '22 14:10

Lemming