Automation of entity reading in yesod I'm trying to automate entity reading in my yesod application.

This is what I have:

withEntity
  :: ( PersistEntity a
     , YesodPersistBackend site ~ PersistEntityBackend a
     , PersistStore (YesodPersistBackend site)
     , YesodPersist site )
  =&gt; String
  -&gt; Key a
  -&gt; (Entity a -&gt; ExceptT Text (HandlerT site IO) b)
  -&gt; ExceptT Text (HandlerT site IO) b
withEntity what key f =
  do mrec &lt;- lift . runDB . get $ key
     case mrec of
       Nothing  -&gt; throwError . pack $ "unknown " ++ what
       Just rec -&gt; f (Entity key rec)


Users of my application may send a request for data in DB using integer ID instead of Key a. So I have a wrapper around withEntity:

withEntitySql
  :: ( PersistEntityBackend a ~ SqlBackend
     , ToBackendKey SqlBackend a )
  =&gt; String
  -&gt; Int64
  -&gt; (Entity a -&gt; ExceptT Text (HandlerT App IO) b)
  -&gt; ExceptT Text (HandlerT App IO) b
withEntitySql what key f = withEntity what (toSqlKey key) f


This way I can write functions specifying error messages when record doesn't exist:

withA
  :: Int64
  -&gt; (Entity A -&gt; ExceptT Text (HandlerT App IO) a)
  -&gt; ExceptT Text (HandlerT App IO) a
withA =
  withEntitySql "A"

withB
  :: Int64
  -&gt; (Entity B -&gt; ExceptT Text (HandlerT App IO) a)
  -&gt; ExceptT Text (HandlerT App IO) a
withB =
  withEntitySql "B"


I can combine this functions with each other:

withA aId $ \ ea -&gt;
  withB bId $ \ eb -&gt; do
    ...


On the top level in handler for route I wrap the result of runExceptT into json object so client can see if something went wrong with his request.

I don't like that I have to write a function for each entity I'm working with in order to specify error message. I'm not sure how to improve withEntity to determine error message by itself.
I would experiment with something like the following:

import Data.Typeable

withEntitySql
  :: ( PersistEntityBackend a ~ SqlBackend
     , ToBackendKey SqlBackend a
     , Typeable a )
  =&gt; Int64
  -&gt; (Entity a -&gt; ExceptT Text (HandlerT App IO) b)
  -&gt; ExceptT Text (HandlerT App IO) b
withEntitySql key f = withEntity (show $ typeRep (Proxy :: Proxy a)) (toSqlKey key) f