Search code examples
haskellyesodhaskell-persistent

get persistent's field definitions for my model


given a persistent model definition like this:

mkPersist sqlSettings [persistLowerCase|
Person
    name String
    age Int
    deriving Show
|]

I'm looking for a way to get the field definitions for this model. FieldDef looks like a promising datatype, but persistent does not generate a getPersonFields :: [FieldDef] function, so how can it be done?

In case this is a XY problem - here's the background: I want to return some kind of metadata in case of json parse errors. If I try to POST a new person but the json is wrong, I want to respond with something like:

{
    "result": "error",
    "code": 8,
    "message": "Could not parse payload as person",
    "fields": [
        {
            "name": "name",
            "type": "string"
        },
        {
            "name": "age",
            "type": "int"
        }
    ]
}

Solution

  • A sample example showing how it is done:

    #!/usr/bin/env stack
    {- stack
         --resolver lts-9.0
         --install-ghc
         runghc
         --package persistent
         --package persistent-sqlite
         --package persistent-template
    -}
    
    {-# LANGUAGE EmptyDataDecls             #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE GADTs                      #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE QuasiQuotes                #-}
    {-# LANGUAGE TemplateHaskell            #-}
    {-# LANGUAGE TypeFamilies               #-}
    import           Control.Monad.IO.Class  (liftIO)
    import           Database.Persist
    import           Database.Persist.Sqlite
    import           Database.Persist.TH
    
    share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
    Person
        name String
        age Int Maybe
        deriving Show
    BlogPost
        title String
        authorId PersonId
        deriving Show
    |]
    
    main :: IO ()
    main = let efields = entityFields $ entityDef (undefined :: Maybe Person)
           in print efields
    

    Demo:

    $ stack efield.hs
    [FieldDef {fieldHaskell = HaskellName {unHaskellName = "name"}, fieldDB = DBName {unDBName = "name"}, fieldType = FTTypeCon Nothing "String", fieldSqlType = SqlString, fieldAttrs = [], fieldStrict = True, fieldReference = NoReference},FieldDef {fieldHaskell = HaskellName {unHaskellName = "age"}, fieldDB = DBName {unDBName = "age"}, fieldType = FTTypeCon Nothing "Int", fieldSqlType = SqlInt64, fieldAttrs = ["Maybe"], fieldStrict = True, fieldReference = NoReference}]