How to achieve a user-defined order with IHP?

Question

I need to order pages (defined by user, drag and drop), something like ("Hello", order 1), ("Bye", order 2) And then insert, let's say ("Good", order 1), so the collection would change to ("Good", order 1), ("Hello", order 2), ("Bye", order 3). Any ideas how to achieve this with IHP/Postgres?

I have looked at

https://begriffs.com/posts/2018-03-20-user-defined-order.html

Are those the best solutions we have to date?

Answer 1

I usually use the integer position column approach. Here's an example code from a real world IHP app:

In this case we have offers column with a position integer column, like this:

CREATE TABLE offers (
    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
    created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
    name TEXT NOT NULL,
    "location" TEXT NOT NULL,
    contact TEXT NOT NULL,
    description TEXT NOT NULL,
    "position" INT NOT NULL
);

The controller looks like this:

module Web.Controller.Offers where

import Web.Controller.Prelude
import Web.View.Offers.Edit
import Web.View.Offers.Show
import Web.View.Offers.New
import Web.View.Offers.Index
import qualified Application.Offer as Offer


import qualified Control.Monad.State.Lazy as State

instance Controller OffersController where
    beforeAction = ensureIsUser

    action NewOfferAction = do
        let backField :: Offer = newRecord
        render NewView { .. }

    action OffersAction = do
        backFields <- query @Offer |> orderBy #position |> fetch
        render IndexView { .. }

    action ShowOfferAction { .. } = do
        backField <- fetch backFieldId
        render ShowView { .. }

    action EditOfferAction { .. } = do
        backField <- fetch backFieldId
        render EditView { .. }

    action UpdateOfferAction { .. } = do
        backField <- fetch backFieldId
        backField
            |> buildOffer
            |> ifValid \case
                Left backField -> render EditView { .. }
                Right backField -> do
                    backField <- updateRecord backField
                    setSuccessMessage "Offer updated"
                    redirectTo EditOfferAction { .. }

    action CreateOfferAction = do
        nextPosition <- Offer.nextPosition
        newRecord @Offer
            |> buildOffer
            |> ifValid \case
            Left backField -> render NewView { .. }
            Right backField -> do
                backField <- backField
                    |> createRecord
                setSuccessMessage "Angebot erstellt"
                redirectTo OffersAction

    action DeleteOfferAction { .. } = do
        backField <- fetch backFieldId
        deleteRecord backField
        setSuccessMessage "Deleted Offer successfully"
        redirectTo OffersAction

    action OfferMoveUpAction { .. } = do
        backField <- fetch backFieldId
        prevOffer <- backField |> Offer.prevOffer
        case prevOffer of
            Just prevOffer -> do
                let backFieldPosition = get #position backField
                let prevOfferPosition = get #position prevOffer
                updateRecord (backField |> set #position prevOfferPosition)
                updateRecord (prevOffer |> set #position backFieldPosition)
                return ()
            Nothing -> return ()
        redirectTo OffersAction

    action OfferMoveDownAction { .. } = do
        backField <- fetch backFieldId
        nextOffer <- backField |> Offer.nextOffer
        case nextOffer of
            Just nextOffer -> do
                let backFieldPosition = get #position backField
                let nextOfferPosition = get #position nextOffer
                updateRecord (backField |> set #position nextOfferPosition)
                updateRecord (nextOffer |> set #position backFieldPosition)
                return ()
            Nothing -> return ()
        redirectTo OffersAction


buildOffer :: _ => backField -> backField
buildOffer backField =
    backField
    |> fill @'["name", "description", "position", "location", "contact"]
    |> validateField #name nonEmpty

Some helper functions used from the controller are defined inside another module (but you could just put them into the controller if you want):

module Application.Offer (nextPosition, prevOffer, nextOffer) where

import IHP.Prelude
import IHP.ModelSupport
import IHP.QueryBuilder
import Generated.Types
import qualified Database.PostgreSQL.Simple as PG

instance DefaultScope "offers" where
    defaultScope = orderBy #position

nextPosition :: (?modelContext :: ModelContext) => IO Int
nextPosition = sqlQueryScalar "SELECT COUNT(*) FROM offers" ()

prevOffer :: (?modelContext :: ModelContext) => Offer -> IO (Maybe Offer)
prevOffer offer = do
    results <- sqlQuery "SELECT * FROM offers WHERE position < ? ORDER BY position DESC LIMIT 1" (PG.Only (get #position offer))
    return $ headMay results

nextOffer :: (?modelContext :: ModelContext) => Offer -> IO (Maybe Offer)
nextOffer offer = do
    results <- sqlQuery "SELECT * FROM offers WHERE position > ? ORDER BY position ASC LIMIT 1" (PG.Only (get #position offer))
    return $ headMay results