diff --git a/Cookbook.md b/Cookbook.md index 65f8f36..34a16cf 100644 --- a/Cookbook.md +++ b/Cookbook.md @@ -38,6 +38,7 @@ For non-Yesod code, see also [Snippets](https://github.com/yesodweb/yesod-cookbo * [Example MySQL Connection code](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Example-MySQL-Connection-code.md) * [Activate foreign key checking in Sqlite](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Activate-foreign-key-checking-in-Sqlite.md) * [Adding Seed data to Scaffolded Site](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Adding-Seed-Data-to-Scaffolded-Site.md) +* [Handling exception in persistence](https://github.com/yesodweb/yesod-cookbook/blob/master/cookbook/Handling-Persistence-Exception.md) ## State diff --git a/cookbook/Handling-Persistence-Exception.md b/cookbook/Handling-Persistence-Exception.md new file mode 100644 index 0000000..984ee98 --- /dev/null +++ b/cookbook/Handling-Persistence-Exception.md @@ -0,0 +1,242 @@ +# Handling exception in persistence + +Say, you have a code like this which throws an exception: + +``` haskell +share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| +User + age Int + UniqueAge age + deriving Show +|] + +getUsers :: MonadIO m => ReaderT SqlBackend m [Entity User] +getUsers = selectList [] [] + +insertJane :: MonadIO m => ReaderT SqlBackend m () +insertJane = insert_ $ User 40 + +sqliteTest :: IO () +sqliteTest = runSqlite ":memory:" $ do + runMigration migrateAll + + insertJane + insertJane + + users <- getUsers + liftIO $ print (users :: [Entity User]) +``` + +The above code will throw an exception when executed because the uniqueness constraint is being violated: + +``` +$ ./sqlite-code + +Migrating: CREATE TABLE "user"("id" INTEGER PRIMARY KEY,"age" INTEGER NOT NULL,CONSTRAINT "unique_age" UNIQUE ("age")) +persistent-try-bugs: SQLite3 returned ErrorConstraint while attempting to perform step. +``` + +You can use the [exceptions](https://hackage.haskell.org/package/exceptions) package to handle exceptions. Have the appropriate imports: + +``` +import Control.Exception (SomeException) +import Control.Monad.Catch +``` + +And the rest of the code is like this: + +``` haskell +share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| +User + age Int + UniqueAge age + deriving Show +|] + +getUsers :: MonadIO m => ReaderT SqlBackend m [Entity User] +getUsers = selectList [] [] + +insertJane :: (MonadCatch m, MonadIO m) => ReaderT SqlBackend m () +insertJane = (insert_ (User 40)) `catch` (\(SomeException e) -> return ()) + +sqliteTest :: IO () +sqliteTest = runSqlite ":memory:" $ do + runMigration migrateAll + + insertJane + insertJane + + users <- getUsers + liftIO $ print (users :: [Entity User]) +``` + +And this time, it will execute without crashing: + +``` +$ ./sqlite-code + +Migrating: CREATE TABLE "user"("id" INTEGER PRIMARY KEY,"age" INTEGER NOT NULL,CONSTRAINT "unique_age" UNIQUE ("age")) +[Entity {entityKey = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = User {userAge = 40}}] +``` + +While the above code works for `sqlite` database, it will fail when used with `PostgreSql` and others. First Let's check in the sql shell, the current data: + +``` sql +perm2=# select id, age from public.user; + id | age +----+----- +(0 rows) +``` + +Okay, now let's run this code: + +```haskell +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Postgresql where + +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger (runNoLoggingT) +import Database.Persist +import Control.Monad.Reader +import Data.Text +import Database.Persist.Sql +import Database.Persist.Postgresql +import Database.Persist.TH +import Control.Exception (SomeException) +import Control.Monad.Catch + +share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| +User + age Int + UniqueAge age + deriving Show +|] + +getUsers :: MonadIO m => ReaderT SqlBackend m [Entity User] +getUsers = selectList [] [] + +insertJane :: (MonadCatch m, MonadIO m) => ReaderT SqlBackend m () +insertJane = (insert_ (User 40)) `catch` (\(SomeException e) -> return ()) + +conn = "host=localhost dbname=perm2 user=postgres password=postgres port=5432" + +postgreSQLTest :: IO () +postgreSQLTest = runNoLoggingT $ withPostgresqlPool conn 10 $ liftSqlPersistMPool $ do + + liftIO $ print "Going to insert jane twice" + + insertJane + insertJane -- This should cause exception + + users <- getUsers + liftIO $ print users + +``` + +Executing it: + +$ ./postgresql-code + +``` shellsession +"Going to insert jane twice" +persistent-try-bugs: SqlError {sqlState = "25P02", sqlExecStatus = FatalError, sqlErrorMsg = "current transaction is aborted, commands ignored until end of transaction block", sqlErrorDetail = "", sqlErrorHint = ""} +``` + +Note how the entire transaction is aborted. You can inspect the data in the sql shell itself: + +``` sql +perm2=# select id, age from public.user; + id | age +----+----- +(0 rows) +``` + +This below code shows how to handle exception in a database like `PostgreSQL`. The key is to split your queries into transactions and catching exception on the transaction. + +``` haskell +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Postgresql where + +import Database.Persist +import Data.Pool (Pool) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Logger (runNoLoggingT) +import Database.Persist +import Control.Monad.Reader +import Data.Text +import Database.Persist.Sql +import Database.Persist.Postgresql +import Database.Persist.TH +import Control.Exception (SomeException) +import Control.Monad.Catch + +share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| +User + age Int + UniqueAge age + deriving Show +|] + +getUsers :: MonadIO m => ReaderT SqlBackend m [Entity User] +getUsers = selectList [] [] + +insertJane :: MonadIO m => ReaderT SqlBackend m () +insertJane = insert_ $ User 40 + +mapLiftSqlPersistMPool :: MonadIO m => [SqlPersistM a] -> Pool SqlBackend -> m () +mapLiftSqlPersistMPool xs pool = mapM_ (\x -> liftSqlPersistMPool x pool) xs + +conn = "host=localhost dbname=perm2 user=postgres password=postgres port=5432" + +postgreSQLTest :: IO () +postgreSQLTest = runNoLoggingT $ withPostgresqlPool conn 10 $ + mapLiftSqlPersistMPool [transaction1, transaction2] + +transaction1 :: (MonadIO m, MonadCatch m) => ReaderT SqlBackend m () +transaction1 = (do + liftIO $ print "Inside transaction 1" + insertJane + insertJane -- This should cause exception + liftIO $ print "This should not be printed (transaction 1)" + u <- getUsers + liftIO $ print u + return ()) `catch` (\(SomeException e) -> return ()) + + +transaction2 :: (MonadIO m, MonadCatch m) => ReaderT SqlBackend m () +transaction2 = do + liftIO $ print "Inside transaction 2" + users <- getUsers + liftIO $ print users + liftIO $ print "This should just print fine (transaction 2)" + return () +``` + +On execution: + +``` shellsession +$ ./postgresql-code +"Inside transaction 1" +"Inside transaction 2" +[] +"This should just print fine (transaction 2)" +``` +