pg-transact 0.3.0.0 → 0.3.1.0

raw patch · 4 files changed

+64/−3 lines, 4 filesdep +postgresql-libpqPVP ok

version bump matches the API change (PVP)

Dependencies added: postgresql-libpq

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• pg-transact.cabal +4/−1
• src/Database/PostgreSQL/Transact.hs +22/−1
• test/Database/PostgreSQL/TransactSpec.hs +35/−1

@@ -1,3 +1,6 @@+- 0.3.1.0+  - #5 Add abort+ - 0.3.0.0   - #4 Generalize `rollback` and related queries to use DBT   - #3 Remove MonadThrow constraint from queryOne

@@ -1,5 +1,5 @@ name:                pg-transact-version:             0.3.0.0+version:             0.3.1.0 synopsis: A postgresql-simple transaction monad description: Another postgresql-simple transaction monad homepage:            https://github.com/jfischoff/pg-transact#readme@@ -14,7 +14,9 @@                   , CHANGELOG.md cabal-version:       >=1.10 + library+  default-extensions: TypeApplications   hs-source-dirs:      src   exposed-modules:     Database.PostgreSQL.Transact   build-depends:       base >= 4.7 && < 5@@ -40,6 +42,7 @@                , pg-transact                , tmp-postgres >= 1.34.0.0                , hspec-expectations-lifted+               , postgresql-libpq   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -14,6 +14,7 @@ import qualified Data.ByteString as BS import qualified Control.Monad.Fail as Fail import Control.Applicative+import Data.Typeable  newtype DBT m a = DBT { unDBT :: ReaderT Connection m a }   deriving (MonadTrans, MonadThrow)@@ -47,13 +48,19 @@ isClass25 :: SqlError -> Bool isClass25 SqlError{..} = BS.take 2 sqlState == "25" +isNoTransaction :: SqlError -> Bool+isNoTransaction SqlError{..} = sqlState == "25P01"+ instance (MonadIO m, MonadMask m) => MonadCatch (DBT m) where   catch (DBT act) handler = DBT $ mask $ \restore -> do     conn <- ask     sp   <- liftIO $ Simple.newSavepoint conn     let setup = catch (restore act) $ \e -> do                   liftIO $ Simple.rollbackToSavepoint conn sp-                  unDBT $ handler e+                    `catch` (\re -> if isNoTransaction re then pure () else throwM re)+                  if typeRep (Proxy @ Abort) == typeOf e+                    then (throwM Abort)+                    else unDBT $ handler e      setup `finally` liftIO (tryJust (guard . isClass25) (Simple.releaseSavepoint conn sp)) @@ -223,3 +230,17 @@ rollback actionToRollback = mask $ \restore -> do   sp <- savepoint   restore actionToRollback `finally` rollbackToAndReleaseSavepoint sp++data Abort = Abort+  deriving (Show, Eq, Typeable)++instance Exception Abort++-- | A 'abort' is a similar to 'rollback' but calls 'ROLLBACK' to abort the+--   transaction. 'abort's is global. It affects everything before and after+--   it is called. Duplicate 'abort's do nothing.+--   Calling 'abort' throws an 'Abort' exception that is not caught+--   by the transaction running functions. If you call 'abort' you need to+--   also be prepared to handle the 'Abort' exception.+abort :: (MonadMask m, MonadIO m) => DBT m a -> DBT m a+abort = flip finally ((execute_ "ROLLBACK") >> throwM Abort)

@@ -14,7 +14,7 @@ import           Database.PostgreSQL.Simple.SqlQQ import           Database.PostgreSQL.Transact import qualified Database.Postgres.Temp as Temp-import           Test.Hspec (Spec, SpecWith, describe, beforeAll, afterAll, it, shouldThrow, runIO)+import           Test.Hspec (Spec, SpecWith, describe, beforeAll, afterAll, it, runIO, shouldThrow) import           Test.Hspec.Expectations.Lifted (shouldReturn) import           Data.IORef import           Control.Concurrent@@ -23,6 +23,9 @@ import qualified Control.Exception as E import           Control.Monad ((<=<)) +-- import qualified Database.PostgreSQL.Simple.Internal as PS+-- import qualified Database.PostgreSQL.LibPQ as PG+ aroundAll :: forall a. ((a -> IO ()) -> IO ()) -> SpecWith a -> Spec aroundAll withFunc specWith = do   (var, stopper, asyncer) <- runIO $@@ -59,9 +62,11 @@     withConn db $ \conn -> do       void $ PS.execute_ conn $           [sql| CREATE TABLE fruit (name VARCHAR(100) PRIMARY KEY ) |]+--      f conn `finally` (PS.withConnection conn (maybe (print "invalid") (print <=< PG.cancel) <=< PG.getCancel))       f conn  + withDb :: DB a -> Connection -> IO a withDb action conn = runDB conn action @@ -190,3 +195,32 @@           throwM Forbidden        getFruits `shouldReturn` ["grapes"]++  aroundAll withSetup $ do+    it "abort ... abort effects on expected finish" $ \conn -> runDB conn (do+      insertFruit "grapes"+      abort $ do+        insertFruit "oranges"+        getFruits `shouldReturn` ["grapes", "oranges"]++      getFruits `shouldReturn` []+      ) `shouldThrow` (\Abort -> True)++  aroundAll withSetup $ do+    it "abort ... abort effects on exception" $ \conn -> runDB conn ( do+      insertFruit "grapes"+      _ :: Either Forbidden () <- try $ abort $ do+          insertFruit "oranges"+          getFruits `shouldReturn` ["grapes", "oranges"]+          throwM Forbidden++      getFruits `shouldReturn` []+      ) `shouldThrow` (\Abort -> True)++  aroundAll withSetup $ do+    it "abort ... abort throws a warning only when nested" $ \conn -> do+      runDB conn (abort (abort (pure ()))) `shouldThrow` (\Abort -> True)++  aroundAll withSetup $ do+    it "abort ... can't be caught" $ \conn -> do+      runDB conn (abort (pure ()) `catch` (\Abort -> pure ())) `shouldThrow` (\Abort -> True)