hpqtypes-extras 1.9.0.1 → 1.10.0.0
raw patch · 6 files changed
+62/−50 lines, 6 filesdep +uuid-typesdep ~fields-jsondep ~hpqtypesnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: uuid-types
Dependency ranges changed: fields-json, hpqtypes
API changes (from Hackage documentation)
+ Database.PostgreSQL.PQTypes.Model.ColumnType: UuidT :: ColumnType
Files
- CHANGELOG.md +4/−0
- hpqtypes-extras.cabal +5/−4
- src/Database/PostgreSQL/PQTypes/Model/Check.hs +1/−1
- src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs +3/−0
- src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs +1/−1
- test/Main.hs +48/−44
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 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.
hpqtypes-extras.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: hpqtypes-extras-version: 1.9.0.1+version: 1.10.0.0 synopsis: Extra utilities for hpqtypes library description: The following extras for hpqtypes library: .@@ -51,14 +51,14 @@ , Database.PostgreSQL.PQTypes.Utils.NubList build-depends: base >= 4.9 && < 4.13- , hpqtypes >= 1.7.0.0 && < 1.8.0.0+ , hpqtypes >= 1.8.0.0 && < 1.9.0.0 , base16-bytestring >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.7 , cryptohash >= 0.11 && < 0.12 , exceptions >= 0.10 && < 0.11 , mtl >= 2.2 && < 2.3- , fields-json >= 0.2 && < 0.3+ , fields-json >= 0.4 && < 0.5 , text >= 1.2 && < 1.3 , lifted-base >= 0.2 && < 0.3 , monad-control >= 1.0 && < 1.1@@ -109,4 +109,5 @@ tasty, tasty-hunit, text,- transformers+ transformers,+ uuid-types
src/Database/PostgreSQL/PQTypes/Model/Check.hs view
@@ -46,7 +46,7 @@ -- | Validate check previously created as NOT VALID. sqlValidateCheck :: Check -> RawSQL ()-sqlValidateCheck Check{..} = "VALIDATE" <+> chkName+sqlValidateCheck Check{..} = "VALIDATE CONSTRAINT" <+> chkName sqlAddCheck_ :: Bool -> Check -> RawSQL () sqlAddCheck_ valid Check{..} = smconcat [
src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs view
@@ -18,6 +18,7 @@ | DateT | DoubleT | IntegerT+ | UuidT | IntervalT | JsonT | JsonbT@@ -44,6 +45,7 @@ "date" -> DateT "double precision" -> DoubleT "integer" -> IntegerT+ "uuid" -> UuidT "interval" -> IntervalT "json" -> JsonT "jsonb" -> JsonbT@@ -64,6 +66,7 @@ columnTypeToSQL DateT = "DATE" columnTypeToSQL DoubleT = "DOUBLE PRECISION" columnTypeToSQL IntegerT = "INTEGER"+columnTypeToSQL UuidT = "UUID" columnTypeToSQL IntervalT = "INTERVAL" columnTypeToSQL JsonT = "JSON" columnTypeToSQL JsonbT = "JSONB"
src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs view
@@ -87,7 +87,7 @@ -- | Validate foreign key previously created as NOT VALID. sqlValidateFK :: RawSQL () -> ForeignKey -> RawSQL ()-sqlValidateFK tname fk = "VALIDATE" <+> fkName tname fk+sqlValidateFK tname fk = "VALIDATE CONSTRAINT" <+> fkName tname fk sqlAddFK_ :: Bool -> RawSQL () -> ForeignKey -> RawSQL () sqlAddFK_ valid tname fk@ForeignKey{..} = mconcat [
test/Main.hs view
@@ -7,9 +7,9 @@ import Data.Monoid import Prelude-import Data.Int import qualified Data.Text as T import Data.Typeable+import Data.UUID.Types import Database.PostgreSQL.PQTypes import Database.PostgreSQL.PQTypes.Checks@@ -39,7 +39,7 @@ optionHelp = return "Postgres connection string" -- Simple example schemata inspired by the one in--- <http://www.databaseanswers.org/data_models/bank_robberies/index.htm>+-- < http://www.databaseanswers.org/data_models/bank_robberies/index.htm> -- -- Schema 1: Bank robberies, tables: -- bank, bad_guy, robbery, participated_in_robbery, witness,@@ -63,8 +63,9 @@ { tblName = "bank" , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "id", colType = BigSerialT- , colNullable = False }+ [ tblColumn { colName = "id", colType = UuidT+ , colNullable = False+ , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "name", colType = TextT , colNullable = False } , tblColumn { colName = "location", colType = TextT@@ -140,8 +141,9 @@ { tblName = "bad_guy" , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "id", colType = BigSerialT- , colNullable = False }+ [ tblColumn { colName = "id", colType = UuidT+ , colNullable = False+ , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "firstname", colType = TextT , colNullable = False } , tblColumn { colName = "lastname", colType = TextT@@ -167,9 +169,10 @@ { tblName = "robbery" , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "id", colType = BigSerialT- , colNullable = False }- , tblColumn { colName = "bank_id", colType = BigIntT+ [ tblColumn { colName = "id", colType = UuidT+ , colNullable = False+ , colDefault = Just "gen_random_uuid()" }+ , tblColumn { colName = "bank_id", colType = UuidT , colNullable = False } , tblColumn { colName = "date", colType = DateT , colNullable = False, colDefault = Just "now()" }@@ -195,9 +198,9 @@ { tblName = "participated_in_robbery" , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "bad_guy_id", colType = BigIntT+ [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False }- , tblColumn { colName = "robbery_id", colType = BigIntT+ , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } ] , tblPrimaryKey = pkOnColumns ["bad_guy_id", "robbery_id"]@@ -225,8 +228,9 @@ { tblName = tableWitnessName , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "id", colType = BigSerialT- , colNullable = False }+ [ tblColumn { colName = "id", colType = UuidT+ , colNullable = False+ , colDefault = Just "gen_random_uuid()" } , tblColumn { colName = "firstname", colType = TextT , colNullable = False } , tblColumn { colName = "lastname", colType = TextT@@ -243,9 +247,9 @@ { tblName = tableWitnessedRobberyName , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "witness_id", colType = BigIntT+ [ tblColumn { colName = "witness_id", colType = UuidT , colNullable = False }- , tblColumn { colName = "robbery_id", colType = BigIntT+ , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } ] , tblPrimaryKey = pkOnColumns ["witness_id", "robbery_id"]@@ -261,9 +265,9 @@ { tblName = tableUnderArrestName , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "bad_guy_id", colType = BigIntT+ [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False }- , tblColumn { colName = "robbery_id", colType = BigIntT+ , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } , tblColumn { colName = "court_date", colType = DateT , colNullable = False@@ -282,9 +286,9 @@ { tblName = tablePrisonSentenceName , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "bad_guy_id", colType = BigIntT+ [ tblColumn { colName = "bad_guy_id", colType = UuidT , colNullable = False }- , tblColumn { colName = "robbery_id", colType = BigIntT+ , tblColumn { colName = "robbery_id", colType = UuidT , colNullable = False } , tblColumn { colName = "sentence_start" , colType = DateT@@ -317,7 +321,7 @@ { tblName = tableFlashName , tblVersion = 1 , tblColumns =- [ tblColumn { colName = "flash_id", colType = BigIntT, colNullable = False }+ [ tblColumn { colName = "flash_id", colType = UuidT, colNullable = False } ] } @@ -438,7 +442,7 @@ createTablesSchema1 :: (String -> TestM ()) -> TestM () createTablesSchema1 step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Creating the database (schema version 1)..."@@ -446,7 +450,7 @@ composites schema1Tables schema1Migrations checkDatabase defaultExtrasOptions composites domains schema1Tables -testDBSchema1 :: (String -> TestM ()) -> TestM ([Int64], [Int64])+testDBSchema1 :: (String -> TestM ()) -> TestM ([UUID], [UUID]) testDBSchema1 step = do step "Running test queries (schema version 1)..." @@ -460,7 +464,7 @@ , "2/3 Quux Ave., Milton Keynes, UK" , "6600 Sunset Blvd., Los Angeles, CA, USA"] sqlResult "id"- (bankIds :: [Int64]) <- fetchMany runIdentity+ (bankIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'bank' table" 5 (length bankIds) -- Populate the 'bad_guy' table.@@ -470,14 +474,14 @@ sqlSetList "lastname" ["Hetzel"::T.Text, "Murray", "Foreman", "Fraser" ,"Crosbie", "Shaw"] sqlResult "id"- (badGuyIds :: [Int64]) <- fetchMany runIdentity+ (badGuyIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'bad_guy' table" 6 (length badGuyIds) -- Populate the 'robbery' table. runQuery_ . sqlInsert "robbery" $ do sqlSetList "bank_id" [bankIds !! idx | idx <- [0,3]] sqlResult "id"- (robberyIds :: [Int64]) <- fetchMany runIdentity+ (robberyIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'robbery' table" 2 (length robberyIds) -- Populate the 'participated_in_robbery' table.@@ -485,7 +489,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [0,2]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "bad_guy_id"- (participatorIds :: [Int64]) <- fetchMany runIdentity+ (participatorIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'participated_in_robbery' table" 2 (length participatorIds) @@ -493,7 +497,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "bad_guy_id"- (participatorIds' :: [Int64]) <- fetchMany runIdentity+ (participatorIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'participated_in_robbery' table" 2 (length participatorIds') @@ -504,7 +508,7 @@ sqlSetList "lastname" ["Vickers"::T.Text, "Holloway", "Weyland", "Eliott" ,"Wong"] sqlResult "id"- (witnessIds :: [Int64]) <- fetchMany runIdentity+ (witnessIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witness' table" 5 (length witnessIds) -- Populate the 'witnessed_robbery' table.@@ -512,7 +516,7 @@ sqlSetList "witness_id" [witnessIds !! idx | idx <- [0,1]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "witness_id"- (robberyWitnessIds :: [Int64]) <- fetchMany runIdentity+ (robberyWitnessIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witnessed_robbery' table" 2 (length robberyWitnessIds) @@ -520,7 +524,7 @@ sqlSetList "witness_id" [witnessIds !! idx | idx <- [2,3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "witness_id"- (robberyWitnessIds' :: [Int64]) <- fetchMany runIdentity+ (robberyWitnessIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'witnessed_robbery' table" 3 (length robberyWitnessIds') @@ -528,7 +532,7 @@ migrateDBToSchema2 :: (String -> TestM ()) -> TestM () migrateDBToSchema2 step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 1 -> schema version 2)..."@@ -539,7 +543,7 @@ -- | Hacky version of 'migrateDBToSchema2' used by 'migrationTest3'. migrateDBToSchema2Hacky :: (String -> TestM ()) -> TestM () migrateDBToSchema2Hacky step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Hackily migrating the database (schema version 1 \@@ -550,7 +554,7 @@ where schema2Migrations' = createTableMigration tableFlash : schema2Migrations -testDBSchema2 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM ()+testDBSchema2 :: (String -> TestM ()) -> [UUID] -> [UUID] -> TestM () testDBSchema2 step badGuyIds robberyIds = do step "Running test queries (schema version 2)..." @@ -572,7 +576,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [0,2]] sqlSet "robbery_id" (robberyIds !! 0) sqlResult "bad_guy_id"- (arrestedIds :: [Int64]) <- fetchMany runIdentity+ (arrestedIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'under_arrest' table" 2 (length arrestedIds) @@ -580,7 +584,7 @@ sqlSetList "bad_guy_id" [badGuyIds !! idx | idx <- [3,4]] sqlSet "robbery_id" (robberyIds !! 1) sqlResult "bad_guy_id"- (arrestedIds' :: [Int64]) <- fetchMany runIdentity+ (arrestedIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'under_arrest' table" 2 (length arrestedIds') @@ -588,7 +592,7 @@ migrateDBToSchema3 :: (String -> TestM ()) -> TestM () migrateDBToSchema3 step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 2 -> schema version 3)..."@@ -596,7 +600,7 @@ schema3Tables schema3Migrations checkDatabase defaultExtrasOptions composites domains schema3Tables -testDBSchema3 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM ()+testDBSchema3 :: (String -> TestM ()) -> [UUID] -> [UUID] -> TestM () testDBSchema3 step badGuyIds robberyIds = do step "Running test queries (schema version 3)..." @@ -621,7 +625,7 @@ sqlSet "sentence_length" (12::Int) sqlSet "prison_name" ("Long Kesh"::T.Text) sqlResult "bad_guy_id"- (sentencedIds :: [Int64]) <- fetchMany runIdentity+ (sentencedIds :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'prison_sentence' table" 2 (length sentencedIds) @@ -631,7 +635,7 @@ sqlSet "sentence_length" (9::Int) sqlSet "prison_name" ("Wormwood Scrubs"::T.Text) sqlResult "bad_guy_id"- (sentencedIds' :: [Int64]) <- fetchMany runIdentity+ (sentencedIds' :: [UUID]) <- fetchMany runIdentity liftIO $ assertEqual "INSERT into 'prison_sentence' table" 2 (length sentencedIds') @@ -639,7 +643,7 @@ migrateDBToSchema4 :: (String -> TestM ()) -> TestM () migrateDBToSchema4 step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 3 -> schema version 4)..."@@ -664,7 +668,7 @@ migrateDBToSchema5 :: (String -> TestM ()) -> TestM () migrateDBToSchema5 step = do- let extensions = []+ let extensions = ["pgcrypto"] composites = [] domains = [] step "Migrating the database (schema version 4 -> schema version 5)..."@@ -728,7 +732,7 @@ migrationTest1Body step - freshTestDB step+ -- freshTestDB step -- | Test for behaviour of 'checkDatabase' and 'checkDatabaseAllowUnknownObjects' migrationTest2 :: ConnectionSourceM (LogT IO) -> TestTree@@ -741,7 +745,7 @@ let composite = CompositeType { ctName = "composite" , ctColumns =- [ CompositeColumn { ccName = "cint", ccType = BigIntT }+ [ CompositeColumn { ccName = "cint", ccType = UuidT } , CompositeColumn { ccName = "ctext", ccType = TextT } ] }@@ -802,7 +806,7 @@ step "Recreating the database (schema version 1, one table is missing PK)..." - migrateDatabase optionsNoPKCheck [] [] []+ migrateDatabase optionsNoPKCheck ["pgcrypto"] [] [] schema1TablesWithMissingPK [schema1MigrationsWithMissingPK] checkDatabase optionsNoPKCheck [] [] withMissingPKSchema