persistentでEntityのJSONフォーマットを変更するには

Yesod界隈でよく使われているpersistentは、v1.2.0になったタイミングで、Entity a全体に対するToJSONとFromJSONクラスのインスタンスを提供するようになった。

このインスタンスのJSONフォーマットがちょっと変わっていて、

{"key": 1, "value": {"name": "Taro", "age": 20}}

という形式を想定している。

別のフォーマットを使うようにしたかったら、Haskellで同じ型に別のインスタンスを実装したいときにおなじみのnewtype wrapperを使うことになる。例えばよく使われる

{"id": 1, "name": "Taro", "age": 20}

にするならこんな感じ。

import Control.Lens ((&), (%~))
import Control.Lens.Aeson (_Object)
import Data.Aeson
import Database.Persist

newtype SaneJSON a = SaneJSON (Entity a) deriving Show

instance ToJSON a => ToJSON (SaneJSON a) where
    toJSON (SaneJSON (Entity key val)) =
        toJSON val & _Object %~ HM.insert "id" (toJSON key)

毎度これを定義するのは面倒な上に、うっかりtoJSONする前にSaneJSONでくるむのを忘れると、insaneなJSONが出てきてしまう。

やだなーと思っていた折、githubにissueが登録されたので、Entity aに対するToJSON/FromJSONをなくす方向に誘導してみた。無事#181がmasterにmergeされたので、次のリリースからは

import Database.Persist
import Database.Persist.TH

settings :: MkPersistSettings
settings = sqlSettings
  { mpsEntityJSON = EntityJSON
    { entityToJSON = 'entityIdToJSON
    , entityFromJSON = 'entityIdFromJSON
    }
  }

share [mkPersist settings] [persistLowerCase|
User json
  name Text
  age Int
  deriving Show Eq
|]

みたいな感じで、MkPersistSettingsのmpsEntityJSONに自分の好きなtoJSON/parseJSONをquoteして渡してやることで差し替えられるようになった。entityIdToJSON/entityIdFromJSONは新しくpersistentパッケージで定義されたpredefinedなtoJSON/parseJSON実装の一つ。stage restrictionさえ避ければ、自分の好きな実装に入れ替えられる。