Dealing with complex query results in IHP without having to manually specify columns?

Question

The "Dealing With Complex Query Results" section of https://ihp.digitallyinduced.com/Guide/database.html shows how you can "include extra data" when querying for a database type, by creating a type like this:

data PostWithCommentsCount = PostWithCommentsCount
    { id :: Id Post
    , title :: Text
    , commentsCount :: Int
    }
    deriving (Eq, Show)

This works well, but it has the disadvantage that you need to manually specify all the columns of posts to include in the new PostWithCommentsCount type:

instance FromRow PostWithCommentsCount where
    fromRow =
        PostWithCommentsCount
            <$> field
            <*> field
            <*> field

fetchPostsWithCommentsCount :: (?modelContext :: ModelContext) => IO [PostWithCommentsCount]
fetchPostsWithCommentsCount = do
    trackTableRead "posts" -- This is needed when using auto refresh, so auto refresh knows that your action is accessing the posts table
    sqlQuery "SELECT posts.id, posts.title, (SELECT COUNT(*) FROM comments WHERE comments.post_id = posts.id) AS comments_count FROM posts" ()

This is tedious to maintain over time, if changes in the posts table means you also have to change this manual query. I think it could be better if the type looked like this:

data PostWithCommentsCount = PostWithCommentsCount
    { post :: Post
    , commentsCount :: Int
    }
    deriving (Eq, Show)

So that I wouldn't have to manually specify all the columns of posts that I'm interested in - I would just get all the whole Post. Is there a way to accomplish this currently?

Answer 1

Yes this is possible if you use the following FromRow instance:

instance FromRow PostWithCommentsCount where
    fromRow = do
        post <- fromRow
        commentsCount <- field
        pure PostWithCommentsCount { post, commentsCount }

You can also write this with the operators above like this:

instance FromRow PostWithCommentsCount where
    fromRow = PostWithCommentsCount
        <$> fromRow
        <*> field