I’ve been playing around a bit with a slightly different style of database code lately. Usually, I’d carefully check that a given insertion/update isn’t going to violate any parameters, then actually do it, all wrapped in the implicit surrounding transaction that Persistent gives you. It works, but it never feels quite right; what was the point of telling your database what the constraints were if you’re going to duplicate them anyway?

So, this. It’s a bit of an experiment, but so far I quite like it. The basic idea is that Persistent has the outermost transaction, but we can kinda fake nested transactions using savepoints. It requires Postgresql, but I never really expected to be able to swap in another SQL database anyway, and frankly why would you want to.

Basic idea here is that we want to add an entry to a join table and return whether or not it was there already. Lightly edited for corporate compliance:

data Result
  = NotPresent
  | AlreadyAdded
  | NowAdded
  deriving (Eq,Show)

doAThing :: UUID -> UUID -> DB Result
doAThing barU fooU =
  handle uniqViolation $ do
    inserted <-  insertSelectCount $
       from $
       \(foos,bars) ->
         do where_ (foos ^. FooUuid ==. val fooU)
            where_ (bars ^. BarUuid ==. val barU)
            return $ Baz <# (foos ^. FooId) <&> (bars ^. BarId)
    case inserted of
      0 -> return NotPresent
      1 -> return NowAdded
      n -> throwM (InvalidInsertedCount n)
      :: SqlError -> DB Result
    uniqViolation _e = do
      return AlreadyAdded

    rollbackTransaction, startTransaction, commitTransaction :: DB ()
    startTransaction    = rawExecute "SAVEPOINT             savepointname" []
    commitTransaction   = rawExecute "RELEASE SAVEPOINT     savepointname" []
    rollbackTransaction = rawExecute "ROLLBACK TO SAVEPOINT savepointname" []

EDIT: extracting as a combinator to make the logic a bit clearer:

withViolation :: forall a . DB a -> DB a ->  DB a
withViolation def body = do
  handle violation $ do
    result <- body
    return result
    violation :: SqlError -> DB a
    violation _e = do

    rollbackTransaction, startTransaction, commitTransaction :: DB ()
    startTransaction    = rawExecute "SAVEPOINT             violationSavepoint" []
    commitTransaction   = rawExecute "RELEASE SAVEPOINT     violationSavepoint" []
    rollbackTransaction = rawExecute "ROLLBACK TO SAVEPOINT violationSavepoint" []

I’m @mwotton on twitter, hit me up with opinions, recriminations, etc.


21 July 2016