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 startTransaction inserted <- insertSelectCount $ from $ \(foos,bars) -> do where_ (foos ^. FooUuid ==. val fooU) where_ (bars ^. BarUuid ==. val barU) return $ Baz <# (foos ^. FooId) <&> (bars ^. BarId) commitTransaction case inserted of 0 -> return NotPresent 1 -> return NowAdded n -> throwM (InvalidInsertedCount n) where uniqViolation :: SqlError -> DB Result uniqViolation _e = do rollbackTransaction 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 startTransaction result <- body commitTransaction return result where violation :: SqlError -> DB a violation _e = do rollbackTransaction def 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.