persistent-sql-lifted 0.4.1.0 → 0.4.2.0

raw patch · 4 files changed

+75/−5 lines, 4 filesdep +randomdep +vector

Dependencies added: random, vector

Files

• CHANGELOG.md +5/−1
• library/Database/Persist/Sql/Lifted/Savepoint.hs +60/−0
• package.yaml +4/−1
• persistent-sql-lifted.cabal +6/−3

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.1.0...main)+## [_Unreleased_](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.2.0...main)++## [v0.4.2.0](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.1.0...persistent-sql-lifted-v0.4.2.0)++Add module `Database.Persist.Sql.Lifted.Savepoint`  ## [v0.4.1.0](https://github.com/freckle/persistent-sql-lifted/compare/persistent-sql-lifted-v0.4.0.0...persistent-sql-lifted-v0.4.1.0) 

@@ -0,0 +1,60 @@+module Database.Persist.Sql.Lifted.Savepoint+  ( rollbackWhen+  ) where++import Control.Applicative (pure)+import Control.Monad (replicateM)+import Control.Monad.IO.Class (MonadIO)+import Data.Bool (Bool)+import Data.Char (Char)+import Data.Function (($))+import Data.Functor ((<$>))+import Data.Semigroup ((<>))+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector (Vector)+import Data.Vector qualified as V+import Database.Persist.Sql.Lifted.MonadSqlBackend (MonadSqlBackend)+import Database.Persist.Sql.Lifted.Persistent (rawExecute)+import GHC.Stack (HasCallStack)+import System.Random (randomRIO)+import Prelude ((-))++--  | Create a new transaction @SAVEPOINT@, returning its name+newSavepoint :: (HasCallStack, MonadSqlBackend m) => m Text+newSavepoint = do+  r <- replicateM 8 randomCharacter+  let savepoint = "savepoint_" <> T.pack r+  rawExecute ("SAVEPOINT " <> savepoint) []+  pure savepoint++randomCharacter :: MonadIO m => m Char+randomCharacter = (characterSet V.!) <$> randomRIO (0, V.length characterSet - 1)++characterSet :: Vector Char+characterSet = V.fromList $ ['a' .. 'z'] <> ['1' .. '9']++--  | Release a @SAVEPOINT@+releaseSavepoint :: (HasCallStack, MonadSqlBackend m) => Text -> m ()+releaseSavepoint name = rawExecute ("RELEASE SAVEPOINT " <> name) []++--  | Rollback to a @SAVEPOINT@+rollbackToSavepoint+  :: (HasCallStack, MonadSqlBackend m) => Text -> m ()+rollbackToSavepoint name = rawExecute ("ROLLBACK TO SAVEPOINT " <> name) []++-- | Runs a SQL action with SAVEPOINT, rolling back when specified+rollbackWhen+  :: (HasCallStack, MonadSqlBackend m)+  => (a -> Bool)+  -- ^ When to ROLLBACK based on the result of the action+  -> m a+  -- ^ The action to be run+  -> m a+rollbackWhen shouldRollback act = do+  savepoint <- newSavepoint+  a <- act+  if shouldRollback a+    then rollbackToSavepoint savepoint+    else releaseSavepoint savepoint+  pure a

@@ -1,5 +1,5 @@ name: persistent-sql-lifted-version: 0.4.1.0+version: 0.4.2.0  maintainer: Freckle Education category: Database@@ -54,6 +54,7 @@   - GADTs   - NoImplicitPrelude   - NoMonomorphismRestriction+  - OverloadedStrings  library:   source-dirs: library@@ -63,5 +64,7 @@     - esqueleto     - mtl     - persistent+    - random     - text     - unliftio-core+    - vector

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               persistent-sql-lifted-version:            0.4.1.0+version:            0.4.2.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education@@ -68,6 +68,7 @@         Database.Persist.Sql.Lifted.Query.Locking         Database.Persist.Sql.Lifted.Query.SetOperations         Database.Persist.Sql.Lifted.Query.Update+        Database.Persist.Sql.Lifted.Savepoint         Database.Persist.Sql.Lifted.Update      hs-source-dirs:     library@@ -75,7 +76,7 @@     default-language:   GHC2021     default-extensions:         ExplicitNamespaces FunctionalDependencies GADTs NoImplicitPrelude-        NoMonomorphismRestriction+        NoMonomorphismRestriction OverloadedStrings      ghc-options:         -fignore-optim-changes -fwrite-ide-info -Weverything@@ -92,8 +93,10 @@         esqueleto >=3.6.0.0,         mtl >=2.2.2,         persistent >=2.14.5.0,+        random >=1.2.1.1,         text >=1.2.5.0,-        unliftio-core >=0.2.1.0+        unliftio-core >=0.2.1.0,+        vector >=0.12.3.1      if impl(ghc >=9.8)         ghc-options: