diff --git a/MODULE.md b/MODULE.md index 9ff6518..fa84b62 100644 --- a/MODULE.md +++ b/MODULE.md @@ -196,4 +196,47 @@ instance isSqlValueMaybe :: (IsSqlValue a) => IsSqlValue (Maybe a) +## Module Database.Postgres.Transaction + +#### `withTransaction` + +``` purescript +withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a +``` + +Runs an asynchronous action in a database transaction. The transaction +will be rolled back if the computation fails and committed otherwise. + +Here the first insert will be rolled back: + +```purescript +moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit +moneyTransfer = withTransaction $ \c -> do + execute_ (Query "insert into accounts ...") c + throwError $ error "Something went wrong" + execute_ (Query "insert into accounts ...") c +``` + +#### `begin` + +``` purescript +begin :: forall eff. Client -> Aff (db :: DB | eff) Unit +``` + + +#### `commit` + +``` purescript +commit :: forall eff. Client -> Aff (db :: DB | eff) Unit +``` + + +#### `rollback` + +``` purescript +rollback :: forall eff. Client -> Aff (db :: DB | eff) Unit +``` + + + diff --git a/src/Database/Postgres.purs b/src/Database/Postgres.purs index aa3c0bf..432590d 100644 --- a/src/Database/Postgres.purs +++ b/src/Database/Postgres.purs @@ -17,6 +17,7 @@ module Database.Postgres ) where import Control.Alt +import Control.Apply ((*>)) import Control.Monad.Eff import Control.Monad.Trans import Data.Either @@ -28,7 +29,7 @@ import Data.Maybe import Control.Monad.Aff import Control.Monad.Eff.Class import Control.Monad.Eff.Exception(Error(), error) -import Control.Monad.Error.Class (throwError) +import Control.Monad.Error.Class (throwError, catchError) import Data.Traversable (sequence) import Database.Postgres.SqlValue diff --git a/src/Database/Postgres/Transaction.purs b/src/Database/Postgres/Transaction.purs new file mode 100644 index 0000000..757b6ae --- /dev/null +++ b/src/Database/Postgres/Transaction.purs @@ -0,0 +1,39 @@ +module Database.Postgres.Transaction where + +import Control.Apply ((*>)) +import Control.Monad.Aff +import Control.Monad.Error.Class (throwError) +import Data.Either + +import Database.Postgres +import Database.Postgres.SqlValue + +-- | Runs an asynchronous action in a database transaction. The transaction +-- | will be rolled back if the computation fails and committed otherwise. +-- | +-- | Here the first insert will be rolled back: +-- | +-- | ```purescript +-- | moneyTransfer :: forall e. (Client -> Aff e Unit) -> Client -> Aff e Unit +-- | moneyTransfer = withTransaction $ \c -> do +-- | execute_ (Query "insert into accounts ...") c +-- | throwError $ error "Something went wrong" +-- | execute_ (Query "insert into accounts ...") c +-- | ``` +withTransaction :: forall eff a. (Client -> Aff (db :: DB | eff) a) -> Client -> Aff (db :: DB | eff) a +withTransaction act client = do + begin client + res <- attempt (act client) + either rollback_ commit_ res + where + rollback_ err = rollback client *> throwError err + commit_ v = commit client *> pure v + +begin :: forall eff. Client -> Aff (db :: DB | eff) Unit +begin = execute_ (Query "BEGIN TRANSACTION") + +commit :: forall eff. Client -> Aff (db :: DB | eff) Unit +commit = execute_ (Query "COMMIT") + +rollback :: forall eff. Client -> Aff (db :: DB | eff) Unit +rollback = execute_ (Query "ROLLBACK") diff --git a/test/Main.purs b/test/Main.purs index 7cc2d2e..1ae8b80 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,12 +1,12 @@ module Test.Main where -import Database.Postgres -import Database.Postgres.SqlValue import Debug.Trace import Control.Monad.Eff import Control.Monad.Eff.Class import Control.Monad.Cont.Trans import Control.Monad.Trans +import Control.Monad.Error.Class (throwError) +import Control.Monad.Eff.Exception (error) import Data.Array import Data.Foldable import Data.Either @@ -16,6 +16,10 @@ import Data.Foreign.Class import Data.Foreign.Index import Control.Monad.Aff +import Database.Postgres +import Database.Postgres.SqlValue +import Database.Postgres.Transaction + main = runAff (trace <<< show) (const $ trace "All ok") $ do liftEff <<< trace $ "connecting to " <> mkConnectionString connectionInfo <> "..." exampleUsingWithConnection @@ -26,6 +30,8 @@ main = runAff (trace <<< show) (const $ trace "All ok") $ do exampleQueries + exampleTransaction + liftEff $ disconnect data Artist = Artist @@ -74,6 +80,17 @@ exampleQueries = withClient connectionInfo $ \c -> do artists <- query (Query "select * from artist where name = $1" :: Query Artist) [toSql "Toto"] c liftEff $ printRows artists +exampleTransaction :: forall eff. Aff (db :: DB | eff) Unit +exampleTransaction = withConnection connectionInfo $ \c -> do + execute_ (Query "delete from artist") c + apathize $ tryInsert c + one <- queryOne_ (Query "select * from artist" :: Query Artist) c + liftEff $ trace $ show one + where + tryInsert = withTransaction $ \c -> do + execute_ (Query "insert into artist values ('Not there', 1999)") c + throwError $ error "fail" + printRows :: forall a eff. (Show a) => [a] -> Eff (trace :: Trace | eff) Unit printRows rows = trace $ "result:\n" <> foldMap stringify rows where stringify = show >>> flip (<>) "\n"