add unique postgres tests

test/Common/Test.hs

@@ -25,11 +25,14 @@ module Common.Test
     , testAscRandom
     , testRandomMath
     , migrateAll
+    , migrateUnique
     , cleanDB
+    , cleanUniques
     , RunDbMonad
     , Run
     , p1, p2, p3, p4, p5
     , l1, l2, l3
+    , u1, u2, u3, u4
     , insert'
     , EntityField (..)
     , Foo (..)
@@ -48,6 +51,7 @@ module Common.Test
     , Point (..)
     , Circle (..)
     , Numbers (..)
+    , OneUnique(..)
     ) where
 
 import Control.Monad (forM_, replicateM, replicateM_, void)
@@ -157,8 +161,14 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
     double Double
 |]
 
-
-
+-- Unique Test schema
+share [mkPersist sqlSettings, mkMigrate "migrateUnique"] [persistUpperCase|
+  OneUnique
+    name String
+    value Int
+    UniqueValue value
+    deriving Eq Show
+|]
 
 -- | this could be achieved with S.fromList, but not all lists
 --   have Ord instances
@@ -196,7 +206,17 @@ l2 = Lord "Dorset" Nothing
 l3 :: Lord
 l3 = Lord "Chester" (Just 17)
 
+u1 :: OneUnique
+u1 = OneUnique "First" 0
 
+u2 :: OneUnique
+u2 = OneUnique "Second" 1
+
+u3 :: OneUnique
+u3 = OneUnique "Third" 0
+
+u4 :: OneUnique
+u4 = OneUnique "First" 2
 
 testSelect :: Run -> Spec
 testSelect run = do
@@ -1536,3 +1556,10 @@ cleanDB = do
   delete $ from $ \(_ :: SqlExpr (Entity Point))      -> return ()
 
   delete $ from $ \(_ :: SqlExpr (Entity Numbers))    -> return ()
+
+
+cleanUniques
+  :: (forall m. RunDbMonad m
+  => SqlPersistT (R.ResourceT m) ())
+cleanUniques =
+  delete $ from $ \(_ :: SqlExpr (Entity OneUnique))    -> return ()

test/PostgreSQL/Test.hs

@@ -11,6 +11,7 @@
 module Main (main) where
 
 import Control.Arrow ((&&&))
+import Control.Exception (evaluate)
 import Control.Monad (void, when)
 import Control.Monad.Catch (MonadCatch, catch)
 import Control.Monad.IO.Class (MonadIO(liftIO))
@@ -33,7 +34,7 @@ import qualified Database.Esqueleto.PostgreSQL as EP
 import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.))
 import qualified Database.Esqueleto.PostgreSQL.JSON as JSON
 import Database.Persist.Postgresql (withPostgresqlConn)
-import Database.PostgreSQL.Simple (SqlError(..))
+import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..))
 import System.Environment
 import Test.Hspec
 
@@ -949,6 +950,20 @@ testHashMinusOperator =
           where_ $ v @>. jsonbVal (object [])
           where_ $ f v
 
+testInsertUniqueViolation :: Spec
+testInsertUniqueViolation =
+  describe "Unique Violation on Insert" $
+    it "Unique throws exception" $ run (do
+      u1k <- insert u1
+      u2k <- insert u2
+      insert u3) `shouldThrow` (==) exception
+  where
+    exception = SqlError {
+      sqlState = "23505", 
+      sqlExecStatus = FatalError, 
+      sqlErrorMsg = "duplicate key value violates unique constraint \"UniqueValue\"", 
+      sqlErrorDetail = "Key (value)=(0) already exists.", 
+      sqlErrorHint = ""}
 
 type JSONValue = Maybe (JSONB A.Value)
 
@@ -1021,6 +1036,7 @@ main = do
       testPostgresqlUpdate
       testPostgresqlCoalesce
       testPostgresqlTextFunctions
+      testInsertUniqueViolation
       describe "PostgreSQL JSON tests" $ do
         -- NOTE: We only clean the table once, so we
         -- can use its contents across all JSON tests
@@ -1053,7 +1069,9 @@ run_worker act = withConn $ runSqlConn (migrateIt >> act)
 migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
 migrateIt = do
   void $ runMigrationSilent migrateAll
+  void $ runMigrationSilent migrateUnique
   cleanDB
+  cleanUniques
 
 withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
 withConn =