hpqtypes-extras 1.10.0.0 → 1.10.1.0
raw patch · 4 files changed
+95/−13 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Database.PostgreSQL.PQTypes.SQL.Builder: [sqlInsertOnConflict] :: SqlInsert -> Maybe (SQL, Maybe SQL)
+ Database.PostgreSQL.PQTypes.SQL.Builder: sqlOnConflictDoNothing :: MonadState SqlInsert m => m ()
+ Database.PostgreSQL.PQTypes.SQL.Builder: sqlOnConflictOnColumns :: Sqlable sql => MonadState SqlInsert m => [SQL] -> sql -> m ()
+ Database.PostgreSQL.PQTypes.SQL.Builder: sqlOnConflictOnColumnsDoNothing :: MonadState SqlInsert m => [SQL] -> m ()
- Database.PostgreSQL.PQTypes.SQL.Builder: SqlInsert :: SQL -> [(SQL, Multiplicity SQL)] -> [SQL] -> [(SQL, SQL)] -> SqlInsert
+ Database.PostgreSQL.PQTypes.SQL.Builder: SqlInsert :: SQL -> Maybe (SQL, Maybe SQL) -> [(SQL, Multiplicity SQL)] -> [SQL] -> [(SQL, SQL)] -> SqlInsert
Files
- CHANGELOG.md +5/−1
- hpqtypes-extras.cabal +1/−1
- src/Database/PostgreSQL/PQTypes/SQL/Builder.hs +37/−11
- test/Main.hs +52/−0
CHANGELOG.md view
@@ -1,9 +1,13 @@+# hpqtypes-extras-1.10.1.0 (2020-01-09)+* Add support for ON CONFLICT clause+ # hpqtypes-extras-1.10.0.0 (2019-11-05) * Implement `UuidT` Column Type ([#28](https://github.com/scrive/hpqtypes-extras/pull/28)). * Fix sqlValidateCheck and sqlValidateFK # hpqtypes-extras-1.9.0.1 (2019-06-04)-* Create composite types automatically only if database is empty.+* Create composite types automatically only if database is empty+ ([#24](https://github.com/scrive/hpqtypes-extras/pull/24)). # hpqtypes-extras-1.9.0.0 (2019-05-22) * Extend `checkDatabaseAllowUnknownTables` to allow unknown composite
hpqtypes-extras.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: hpqtypes-extras-version: 1.10.0.0+version: 1.10.1.0 synopsis: Extra utilities for hpqtypes library description: The following extras for hpqtypes library: .
src/Database/PostgreSQL/PQTypes/SQL/Builder.hs view
@@ -162,6 +162,9 @@ , sqlLeftJoinOn , sqlRightJoinOn , sqlFullJoinOn+ , sqlOnConflictDoNothing+ , sqlOnConflictOnColumns+ , sqlOnConflictOnColumnsDoNothing , sqlSet , sqlSetInc , sqlSetList@@ -339,10 +342,11 @@ } data SqlInsert = SqlInsert- { sqlInsertWhat :: SQL- , sqlInsertSet :: [(SQL, Multiplicity SQL)]- , sqlInsertResult :: [SQL]- , sqlInsertWith :: [(SQL, SQL)]+ { sqlInsertWhat :: SQL+ , sqlInsertOnConflict :: Maybe (SQL, Maybe SQL)+ , sqlInsertSet :: [(SQL, Multiplicity SQL)]+ , sqlInsertResult :: [SQL]+ , sqlInsertWith :: [(SQL, SQL)] } data SqlInsertSelect = SqlInsertSelect@@ -444,15 +448,21 @@ "INSERT INTO" <+> sqlInsertWhat cmd <+> parenthesize (sqlConcatComma (map fst (sqlInsertSet cmd))) <+> emitClausesSep "VALUES" "," (map sqlConcatComma (transpose (map (makeLongEnough . snd) (sqlInsertSet cmd)))) <+>+ emitClauseOnConflict (sqlInsertOnConflict cmd) <+> emitClausesSepComma "RETURNING" (sqlInsertResult cmd) where- -- this is the longest list of values- longest = maximum (1 : (map (lengthOfEither . snd) (sqlInsertSet cmd)))- lengthOfEither (Single _) = 1- lengthOfEither (Many x) = length x- makeLongEnough (Single x) = take longest (repeat x)- makeLongEnough (Many x) = take longest (x ++ repeat "DEFAULT")+ emitClauseOnConflict = \case+ Nothing -> ""+ Just (condition, maction) -> emitClause "ON CONFLICT" $+ condition <+> "DO" <+> fromMaybe "NOTHING" maction + -- this is the longest list of values+ longest = maximum (1 : (map (lengthOfEither . snd) (sqlInsertSet cmd)))+ lengthOfEither (Single _) = 1+ lengthOfEither (Many x) = length x+ makeLongEnough (Single x) = take longest (repeat x)+ makeLongEnough (Many x) = take longest (x ++ repeat "DEFAULT")+ instance Sqlable SqlInsertSelect where toSQLCommand cmd = "INSERT INTO" <+> sqlInsertSelectWhat cmd <+>@@ -503,7 +513,7 @@ sqlInsert :: SQL -> State SqlInsert () -> SqlInsert sqlInsert table refine =- execState refine (SqlInsert table mempty [] [])+ execState refine (SqlInsert table Nothing mempty [] []) sqlInsertSelect :: SQL -> SQL -> State SqlInsertSelect () -> SqlInsertSelect sqlInsertSelect table from refine =@@ -800,6 +810,22 @@ instance SqlSet SqlInsertSelect where sqlSet1 cmd name v = cmd { sqlInsertSelectSet = sqlInsertSelectSet cmd ++ [(name, v)] }++sqlOnConflictDoNothing :: MonadState SqlInsert m => m ()+sqlOnConflictDoNothing = modify $ \cmd -> cmd+ { sqlInsertOnConflict = Just ("", Nothing)+ }++sqlOnConflictOnColumns+ :: Sqlable sql => MonadState SqlInsert m => [SQL] -> sql -> m ()+sqlOnConflictOnColumns columns sql = modify $ \cmd -> cmd+ { sqlInsertOnConflict = Just (parenthesize $ sqlConcatComma columns, Just $ toSQLCommand sql)+ }++sqlOnConflictOnColumnsDoNothing :: MonadState SqlInsert m => [SQL] -> m ()+sqlOnConflictOnColumnsDoNothing columns = modify $ \cmd -> cmd+ { sqlInsertOnConflict = Just (parenthesize $ sqlConcatComma columns, Nothing)+ } sqlSetCmd :: (MonadState v m, SqlSet v) => SQL -> SQL -> m () sqlSetCmd name sql = modify (\cmd -> sqlSet1 cmd name sql)
test/Main.hs view
@@ -5,6 +5,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Control +import Data.Either import Data.Monoid import Prelude import qualified Data.Text as T@@ -466,6 +467,57 @@ sqlResult "id" (bankIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'bank' table" 5 (length bankIds)++ -- Try to insert with existing ID to check that ON CONFLICT works properly+ let bankId = head bankIds+ name = "Santander" :: T.Text+ location = "Spain" :: T.Text++ runQuery_ . sqlInsert "bank" $ do+ sqlSet "id" bankId+ sqlSet "name" name+ sqlSet "location" location+ sqlOnConflictOnColumns ["id"] . sqlUpdate "" $ do+ sqlSet "name" name+ sqlSet "location" location+ runQuery_ . sqlSelect "bank" $ do+ sqlResult "name"+ sqlResult "location"+ sqlWhereEq "id" bankId+ details1 <- fetchOne id+ liftIO $ assertEqual "INSERT ON CONFLICT updates" (name, location) details1++ runQuery_ . sqlInsert "bank" $ do+ sqlSet "id" bankId+ sqlSet "name" ("" :: T.Text)+ sqlSet "location" ("" :: T.Text)+ sqlOnConflictDoNothing+ runQuery_ . sqlSelect "bank" $ do+ sqlResult "name"+ sqlResult "location"+ sqlWhereEq "id" bankId+ details3 <- fetchOne id+ liftIO $ assertEqual "INSERT ON CONFLICT does nothing (1)" (name, location) details3++ runQuery_ . sqlInsert "bank" $ do+ sqlSet "id" bankId+ sqlSet "name" ("" :: T.Text)+ sqlSet "location" ("" :: T.Text)+ sqlOnConflictOnColumnsDoNothing ["id"]+ runQuery_ . sqlSelect "bank" $ do+ sqlResult "name"+ sqlResult "location"+ sqlWhereEq "id" bankId+ details4 <- fetchOne id+ liftIO $ assertEqual "INSERT ON CONFLICT does nothing (2)" (name, location) details4++ -- If NO CONFLICT is not specified, make sure we throw an exception.+ eres :: Either DBException () <- E.try . withSavepoint "testDBSchema" $ do+ runQuery_ . sqlInsert "bank " $ do+ sqlSet "id" bankId+ sqlSet "name" name+ sqlSet "location" location+ liftIO $ assertBool "If ON CONFLICT is not specified an exception is thrown" (isLeft eres) -- Populate the 'bad_guy' table. runQuery_ . sqlInsert "bad_guy" $ do