Relationships

Introduction

The following sections assume the following database schema being given. It’s the same as in “Your First Project”.

CREATE TABLE posts (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    title TEXT NOT NULL,
    body TEXT NOT NULL,
    created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
);

CREATE TABLE comments (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    post_id UUID NOT NULL,
    author TEXT NOT NULL,
    body TEXT NOT NULL,
    created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
);

ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE CASCADE;

Has Many Relationships

Given a specific post, we can fetch the post and all its comments like this:

let postId :: Id Post = ...

post <- fetch postId
    >>= fetchRelated #comments

This Haskell code will trigger the following SQL queries to be executed:

SELECT posts.* FROM posts WHERE id = ?  LIMIT 1
SELECT comments.* FROM comments WHERE post_id = ?

In the view we can just access the comments like this:

[hsx|
    <h1>{post.title}</h1>
    <h2>Comments:</h2>
    {post.comments}
|]

The post.comments returns a list of the comments belonging to the post.

The type of post is Include "comments" Post instead of the usual Post. This way the state of a fetched nested resource is tracked at the type level.

It is possible to have multiple nested resources. For example, if Post had a list of comments and tags related to it, it can be defined as Include "comments" (Include "tags" Post) or with the more convenient way as Include' ["comments", "tags"] Post.

Note that for the above example, it is expected that the query will change as-well:

let postId :: Id Post = ...

post <- fetch postId
    >>= fetchRelated #comments
    >>= fetchRelated #tags

Order by

When we want to order the relationship in a certain way, we can just apply our commonly used orderBy function:

let postId :: Id Post = ...

post <- fetch postId
    >>= pure . modify #comments (orderByDesc #createdAt)
    >>= fetchRelated #comments

This works because the comments field of a Post is just a QueryBuilder before we call fetchRelated.

This query builder is equivalent to:

query @Comment |> filterWhere (#postId, post.id)

The call to >>= pure . modify #comments (orderByDesc #createdAt) just appends a |> orderByDesc #createdAt like this:

query @Comment |> filterWhere (#postId, post.id) |> orderByDesc #createdAt

Then the fetchRelated basically just executes this query builder and puts the result back into the comments field of the post record.

Multiple Records

Fetching all Posts with their Comments (One-to-many)

When we want to fetch all the comments for a list of posts, we can use collectionFetchRelated:

posts <- query @Post
    |> fetch
    >>= collectionFetchRelated #comments

This will query all posts with all their comments. The type of posts is [Include "comments" Post].

The above Haskell code will trigger the following two SQL queries to be executed:

SELECT posts.* FROM posts
SELECT comments.* FROM comments WHERE post_id IN (?)

Inside the view you can access the comments like this:

render = [hsx|
    <h1>Posts</h1>
    {forEach posts renderPost}
|]

renderPost :: Include "comments" Post -> Html
renderPost post = [hsx|
    <h2>{post.title}</h2>
    {forEach comments renderComment}
|]
    where
        comments = post.comments

renderComment :: Comment -> Html
renderComment comment = [hsx|
    <div class="comment">{comment.body}</div>
|]

Fetching all Comments with their Posts (Many-to-one)

When we want to fetch all comments and display them with their posts, we need to do the reverse of the above:

comments <- query @Comment
    |> fetch
    >>= collectionFetchRelated #postId

This will query all comments and their respective posts. The type of comments is [Include "postId" Comment].

The Haskell code will trigger the following two SQL queries:

SELECT comments.* FROM comments
SELECT posts.* FROM posts WHERE id IN (?)

Inside the view you can access the comment’s post like this:

render = [hsx|
    <h1>Comments</h1>
    {forEach comments renderComment}
|]

renderComment :: Include "postId" Comment -> Html
renderComment comment = [hsx|
    <h2>{post.title}</h2>
    <div class="comment">{comment.body}</div>
|]
    where
        -- The post is stored inside the postId field of the comment
        post = comment.postId

Order With Multiple Records

If you want to sort the results after fetching multiple records with collectionFetchRelated

posts <-
    query @Post
        |> fetch
        >>= pure . map (modify #comments (orderBy #createdAt))
        >>= collectionFetchRelated #comments

Belongs To Relationships

Given a specific comment, we can fetch the post this comment belongs to. Like other relationships this is also using fetchRelated:

let comment :: Id Comment = ...

comment <- fetch comment
    >>= fetchRelated #postId

This Haskell code will trigger the following SQL queries to be executed:

SELECT comments.* FROM comments WHERE id = ? LIMIT 1
SELECT posts.* FROM posts WHERE id = ?  LIMIT 1

In the view we can just access the comments like this:

[hsx|
    <h1>Comment to {comment.postId.title}</h1>
    <h2>Comments:</h2>
    {comment.body}
|]

The type of comment is Include "postId" Comment instead of the usual Comment. This way the state of a fetched nested resource is tracked at the type level.

Delete Behavior

Usually, all your relations are secured at the database layer by using foreign key constraints. But that means e.g. deleting a post will fail when there still exists comments.

By default, a new foreign key constraint created via the Schema Designer has no on delete behavior specified. Therefore the foreign key constraint will look like this:

ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE NO ACTION;

See the NO ACTION at the end of the statement? We have to change this do CASCADE to delete all comments when the related post is going to be deleted:

ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE CASCADE;

Of course, you can change this using the Schema Designer by clicking on the foreign key next to the post_id column in the comments table.

Joins

For queries involving joins, use typedSql which provides full SQL expressiveness with compile-time type safety. The typedSql quasiquoter connects to your development database at compile time to infer parameter and result types.

Inner Joins with Filters

To retrieve all posts by users from department 5:

posts <- sqlQueryTyped [typedSql|
    SELECT posts.id, posts.title, posts.body, posts.author_id
    FROM posts
    INNER JOIN users ON posts.author_id = users.id
    INNER JOIN departments ON users.department_id = departments.id
    WHERE departments.number = ${5 :: Int}
|]

forEach posts \post -> putStrLn post.title

To find all posts by a specific user:

tomPosts <- sqlQueryTyped [typedSql|
    SELECT posts.id, posts.title, posts.created_at
    FROM posts
    INNER JOIN users ON posts.created_by = users.id
    WHERE users.name = ${"Tom" :: Text}
|]

forEach tomPosts \post -> putStrLn (post.title <> " created at " <> show post.createdAt)

Many-to-many Relationships

Joins are useful for many-to-many relationships. For example, the relationship between blog posts and tags: each post can have multiple tags and each tag can be attached to any number of posts. The following code retrieves all posts with the tag ‘haskell’ or ‘ihp’:

posts <- sqlQueryTyped [typedSql|
    SELECT posts.id, posts.title
    FROM posts
    INNER JOIN taggings ON posts.id = taggings.post_id
    INNER JOIN tags ON taggings.tag_id = tags.id
    WHERE tags.tag_text = ANY(${["haskell", "ihp"] :: [Text]})
|]

forEach posts \post -> putStrLn post.title

To preserve the relationship between tags and posts (i.e. know which post has which tag), select extra columns:

rows <- sqlQueryTyped [typedSql|
    SELECT tags.id, posts.id, posts.title
    FROM posts
    INNER JOIN taggings ON posts.id = taggings.post_id
    INNER JOIN tags ON taggings.tag_id = tags.id
|]

forEach rows \row -> putStrLn (show row.id <> ": " <> row.title)

Ordering on Joined Tables

posts <- sqlQueryTyped [typedSql|
    SELECT posts.id, posts.title
    FROM posts
    INNER JOIN users ON posts.author_id = users.id
    ORDER BY users.name ASC
|]

Outer Joins

typedSql also supports outer joins, which are useful when you want to include rows even when the join condition is not met:

deskStudents <- sqlQueryTyped [typedSql|
    SELECT desks.id, desks.location, students.name
    FROM desks
    LEFT OUTER JOIN student_desk_combos ON student_desk_combos.desk_id = desks.id
    LEFT OUTER JOIN students ON student_desk_combos.student_id = students.id
|]

forEach deskStudents \row ->
    putStrLn (row.location <> ": " <> fromMaybe "unassigned" row.name)

See the Typed SQL guide for more details on parameters, result types, and production builds.

Multiple Nested Records

fetchRelated can be handy to quickly fetch nested records. However, one of its limitations is that you can only go down one level. For example, if you have a Post with a Comment and that Comment references a User (the comment author), you can’t fetch the User.

A common way for solving this would be using a custom data type, and fetching the data manually. Let’s take the above example, and assume we have this schema:

posts:
- id
- title

comments:
- id
- post_id # Reference to the `Post`
- user_ud # Reference to the `User` that is the author.

user:
- id
- name

We can define a custom data type like this under Web/Types.hs:

{-| The result of fetching a `Post` with all the nested records.

@see `fetchPostWithRecords`
-}
data PostWithRecords = PostWithRecords
    { post :: !Post
    , comments :: ![Comment]
    , commentUsers :: ![User]
    } deriving (Show)

And then we can fetch the data like this. Let’s place this code under Application/Helper/Controller.hs as it might be used in multiple controllers:

{-| a `Post` with all the nested records along with the referencing `Comment`s,
and the authors of those comments.
-}
fetchPostWithRecords :: (?modelContext :: ModelContext) => Id Post -> IO PostWithRecords
fetchPostWithRecords postId = do
    post <- fetch postId

    -- Fetch Comments referencing the post ID.
    -- Even though we haven't used `fetchRelated` on the Post we still have the `post.comments` field.
    -- This field field is a query builder with the right `WHERE` condition already applied (referencing the Post ID),
    -- so we only need to `fetch` and don't have to use the more verbose `query`:
    -- comments <- query @Comment
    --     |> filterWhere (#postId, postId)
    --     |> fetch
    comments <- fetch post.comments

    -- Authors of the comments.
    commentUsers <- query @User
        |> filterWhereIn (#id, map (get #userId) comments)
        |> fetch

    return $ PostWithRecords { .. }

Then on the controller of the Post in Web/Controller/Posts.hs we can fetch the data and handover to our Show view:

instance Controller PostsController where

    -- ...

    action ShowPostAction { postId } = do
        -- Fetch the post with all the nested records.
        postWithRecords <- fetchPostWithRecords postId
        render ShowView { .. }

Our view can now use all those records, and show the post title, along with the comments and their authors.

module Web.View.Posts.Show where
import Web.View.Prelude

-- We are now getting the `PostWithRecords` not only the `Post`.
data ShowView = ShowView { postWithRecords :: PostWithRecords }

instance View ShowView where
    html ShowView { .. } = [hsx|
        <h1>Show Post</h1>
        <p>{post.title}</p>
        <h2>Comments</h2>
        {forEach comments (\comment -> showComment comment commentUsers)}
    |]
        where
            -- Extract the records out of the `postWithRecords` variable.
            post = postWithRecords.post
            comments = postWithRecords.comments
            commentUsers = postWithRecords.commentUsers

showComment :: Comment -> [User] -> Html
showComment comment commentUsers =
    [hsx|
        {comment.body} authored by {authorName}
    |]
    where
        authorName = commentUsers
            |> find (\user -> user.id == comment.userId)
            -- Get the user's name. As `head` returns a Maybe value we need to use `maybe ""` which means
            -- if no user found, don't show anything.
            |> maybe "" (get #name)

Many-to-many relationships and views

Let’s say we have the following schema:

posts:
- id

tags:
- id
- name

posts_tags:
- id
- post_id
- tag_id

We want to display a list of all posts with their tags.

We can use it like this:

action PostsAction = do
    posts <- query @Post |> fetch

    postsTags <- query @PostTag
        |> filterWhereIn (#postId, ids posts)
        |> fetch

    tags <- query @Tag
        |> filterWhereIn (#id, map (.tagId) postsTags)
        |> fetch

    render PostsView { .. }

In our view we can now render the posts like this:

html PostsView { .. } = [hsx|
    {forEach posts renderPost}
|]
    where
        renderPost post = [hsx|
            {post}
            {forEach thisTags renderTag}
        |]
            where
                thisTags :: [Tag]
                thisTags = postsTags
                    |> filter (\postTag -> postTag.postId == post.id)
                    |> mapMaybe (\postTag -> find (\tag -> tag.id == postTag.tagId) tags)

        renderTag tag = [hsx|
            <span>{tag.name}</span>
        |]

Disabling Relation Support for Faster Compilation

IHP generates type-level machinery to support fetchRelated and Include: type parameters on record types, QueryBuilder fields for has-many relationships, and Include type family instances. For large schemas this adds significant compile time.

If your project does not use fetchRelated or Include types, you can disable this machinery by setting ihp.relationSupport = false; in your flake.nix:

ihp = {
    enable = true;
    relationSupport = false;
};

This applies to both the dev shell and production builds.

Alternatively, set the environment variable manually:

export IHP_RELATION_SUPPORT=0

What Changes

With IHP_RELATION_SUPPORT=0, the generated types are simplified:

Default (relation support enabled):

data Post' userId comments = Post
    { id :: Id' "posts"
    , title :: Text
    , userId :: userId
    , comments :: comments
    , meta :: MetaBag
    }

type Post = Post' (Id' "users") (QueryBuilder.QueryBuilder "comments")

With IHP_RELATION_SUPPORT=0:

data Post' = Post
    { id :: Id' "posts"
    , title :: Text
    , userId :: (Id' "users")
    , meta :: MetaBag
    }

type Post = Post'

The key differences:

What Stops Working

When relation support is disabled, you cannot use:

You can still query related records manually:

post <- fetch postId
comments <- query @Comment
    |> filterWhere (#postId, post.id)
    |> fetch

When to Use This

This is useful when: