Remove the Default instance for ExtrasOptions.

scrive · May 21, 2019 · 7933788 · 7933788
1 parent f470352
commit 7933788
Show file tree

Hide file tree

Showing 6 changed files with 54 additions and 46 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,3 +1,10 @@
+# hpqtypes-extras-1.9.0.0 (2019-05-21)
+* Remove the `Default` instance for `ExtrasOptions`; use
+  `defaultExtrasOptions` instead
+  ([#23](https://github.com/scrive/hpqtypes-extras/pull/23)).
+* The `ExtrasOptions` constructor is no longer exported; use
+  `defaultExtrasOptions { eoFoo = bar, ... }` instead.
+
 # hpqtypes-extras-1.8.0.0 (2019-04-30)
 * Make composite types subject to migration process
   ([#21](https://github.com/scrive/hpqtypes-extras/pull/21)).

diff --git a/hpqtypes-extras.cabal b/hpqtypes-extras.cabal
@@ -1,6 +1,6 @@
 cabal-version:       1.18
 name:                hpqtypes-extras
-version:             1.8.0.0
+version:             1.9.0.0
 synopsis:            Extra utilities for hpqtypes library
 description:         The following extras for hpqtypes library:
                      .
@@ -51,12 +51,11 @@ library
                  , Database.PostgreSQL.PQTypes.Utils.NubList
 
   build-depends: base > 4 && < 4.13
-               , hpqtypes >= 1.6.0.0
+               , hpqtypes >= 1.7.0.0
                , base16-bytestring
                , bytestring
                , containers
                , cryptohash
-               , data-default
                , exceptions
                , fields-json
                , lifted-base

diff --git a/src/Database/PostgreSQL/PQTypes/Checks.hs b/src/Database/PostgreSQL/PQTypes/Checks.hs
@@ -7,6 +7,7 @@ module Database.PostgreSQL.PQTypes.Checks (
 
   -- * Options
   , ExtrasOptions(..)
+  , defaultExtrasOptions
 
   -- * Migrations
   , migrateDatabase
@@ -24,7 +25,7 @@ import Data.Monoid.Utils
 import Data.Ord (comparing)
 import qualified Data.String
 import Data.Text (Text)
-import Database.PostgreSQL.PQTypes hiding (def)
+import Database.PostgreSQL.PQTypes
 import GHC.Stack (HasCallStack)
 import Log
 import Prelude
@@ -57,7 +58,7 @@ migrateDatabase
   -> [Table]
   -> [Migration m]
   -> m ()
-migrateDatabase options@ExtrasOptions{..}
+migrateDatabase options
   extensions composites domains tables migrations = do
   setDBTimeZoneToUTC
   mapM_ checkExtension extensions

diff --git a/src/Database/PostgreSQL/PQTypes/ExtrasOptions.hs b/src/Database/PostgreSQL/PQTypes/ExtrasOptions.hs
@@ -1,16 +1,20 @@
-module Database.PostgreSQL.PQTypes.ExtrasOptions (
-  ExtrasOptions(..)
+module Database.PostgreSQL.PQTypes.ExtrasOptions
+  ( ExtrasOptions
+  , eoForceCommit
+  , eoEnforcePKs
+  , defaultExtrasOptions
   ) where
-import Data.Default
 
 data ExtrasOptions =
     ExtrasOptions
-    {
-      eoForceCommit :: Bool
-    -- ^ Force commit after every migration
+    { eoForceCommit :: Bool
+      -- ^ Force commit after every migration
     , eoEnforcePKs :: Bool
-    -- ^ Validate that every handled table has a primary key
+      -- ^ Validate that every handled table has a primary key
     } deriving Eq
 
-instance Default ExtrasOptions where
-    def = ExtrasOptions False False
+defaultExtrasOptions :: ExtrasOptions
+defaultExtrasOptions = ExtrasOptions
+  { eoForceCommit = False
+  , eoEnforcePKs  = False
+  }
diff --git a/src/Database/PostgreSQL/PQTypes/Migrate.hs b/src/Database/PostgreSQL/PQTypes/Migrate.hs
@@ -7,7 +7,7 @@ module Database.PostgreSQL.PQTypes.Migrate (
 import Control.Monad
 import qualified Data.Foldable as F
 
-import Database.PostgreSQL.PQTypes hiding (def)
+import Database.PostgreSQL.PQTypes
 import Database.PostgreSQL.PQTypes.Checks.Util
 import Database.PostgreSQL.PQTypes.Model
 import Database.PostgreSQL.PQTypes.SQL.Builder

diff --git a/test/Main.hs b/test/Main.hs
@@ -437,14 +437,13 @@ type TestM a = DBT (LogT IO) a
 
 createTablesSchema1 :: (String -> TestM ()) -> TestM ()
 createTablesSchema1 step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Creating the database (schema version 1)..."
-  migrateDatabase extrasOptions extensions domains
+  migrateDatabase defaultExtrasOptions extensions domains
     composites schema1Tables schema1Migrations
-  checkDatabase extrasOptions composites domains schema1Tables
+  checkDatabase defaultExtrasOptions composites domains schema1Tables
 
 testDBSchema1 :: (String -> TestM ()) -> TestM ([Int64], [Int64])
 testDBSchema1 step = do
@@ -528,27 +527,25 @@ testDBSchema1 step = do
 
 migrateDBToSchema2 :: (String -> TestM ()) -> TestM ()
 migrateDBToSchema2 step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Migrating the database (schema version 1 -> schema version 2)..."
-  migrateDatabase extrasOptions extensions composites domains
+  migrateDatabase defaultExtrasOptions extensions composites domains
     schema2Tables schema2Migrations
-  checkDatabase extrasOptions composites domains schema2Tables
+  checkDatabase defaultExtrasOptions composites domains schema2Tables
 
 -- | Hacky version of 'migrateDBToSchema2' used by 'migrationTest3'.
 migrateDBToSchema2Hacky :: (String -> TestM ()) -> TestM ()
 migrateDBToSchema2Hacky step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Hackily migrating the database (schema version 1 \
        \-> schema version 2)..."
-  migrateDatabase extrasOptions extensions composites domains
+  migrateDatabase defaultExtrasOptions extensions composites domains
     schema2Tables schema2Migrations'
-  checkDatabase extrasOptions composites domains schema2Tables
+  checkDatabase defaultExtrasOptions composites domains schema2Tables
     where
       schema2Migrations' = createTableMigration tableFlash : schema2Migrations
 
@@ -590,14 +587,13 @@ testDBSchema2 step badGuyIds robberyIds = do
 
 migrateDBToSchema3 :: (String -> TestM ()) -> TestM ()
 migrateDBToSchema3 step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Migrating the database (schema version 2 -> schema version 3)..."
-  migrateDatabase extrasOptions extensions composites domains
+  migrateDatabase defaultExtrasOptions extensions composites domains
     schema3Tables schema3Migrations
-  checkDatabase extrasOptions composites domains schema3Tables
+  checkDatabase defaultExtrasOptions composites domains schema3Tables
 
 testDBSchema3 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM ()
 testDBSchema3 step badGuyIds robberyIds = do
@@ -642,14 +638,13 @@ testDBSchema3 step badGuyIds robberyIds = do
 
 migrateDBToSchema4 :: (String -> TestM ()) -> TestM ()
 migrateDBToSchema4 step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Migrating the database (schema version 3 -> schema version 4)..."
-  migrateDatabase extrasOptions extensions composites domains
+  migrateDatabase defaultExtrasOptions extensions composites domains
     schema4Tables schema4Migrations
-  checkDatabase extrasOptions composites domains schema4Tables
+  checkDatabase defaultExtrasOptions composites domains schema4Tables
 
 testDBSchema4 :: (String -> TestM ()) -> TestM ()
 testDBSchema4 step = do
@@ -668,14 +663,13 @@ testDBSchema4 step = do
 
 migrateDBToSchema5 :: (String -> TestM ()) -> TestM ()
 migrateDBToSchema5 step = do
-  let extrasOptions = def
-      extensions    = []
+  let extensions    = []
       composites    = []
       domains       = []
   step "Migrating the database (schema version 4 -> schema version 5)..."
-  migrateDatabase extrasOptions extensions composites domains
+  migrateDatabase defaultExtrasOptions extensions composites domains
     schema5Tables schema5Migrations
-  checkDatabase extrasOptions composites domains schema5Tables
+  checkDatabase defaultExtrasOptions composites domains schema5Tables
 
 testDBSchema5 :: (String -> TestM ()) -> TestM ()
 testDBSchema5 step = do
@@ -744,7 +738,7 @@ migrationTest2 connSource =
   createTablesSchema1 step
   let currentSchema   = schema1Tables
       differentSchema = schema5Tables
-      extrasOptions = def { eoEnforcePKs = True }
+      extrasOptions   = defaultExtrasOptions { eoEnforcePKs = True }
   assertNoException "checkDatabase should run fine for consistent DB" $
     checkDatabase extrasOptions [] [] currentSchema
   assertNoException "checkDatabaseAllowUnknownTables runs fine \
@@ -781,11 +775,13 @@ migrationTest2 connSource =
 
   freshTestDB    step
 
-  let schema1TablesWithMissingPK = schema6Tables
+  let schema1TablesWithMissingPK     = schema6Tables
       schema1MigrationsWithMissingPK = schema6Migrations
-      withMissingPKSchema = schema1TablesWithMissingPK
-      optionsNoPKCheck = def { eoEnforcePKs = False }
-      optionsWithPKCheck = def { eoEnforcePKs = True }
+      withMissingPKSchema            = schema1TablesWithMissingPK
+      optionsNoPKCheck               = defaultExtrasOptions
+                                       { eoEnforcePKs = False }
+      optionsWithPKCheck             = defaultExtrasOptions
+                                       { eoEnforcePKs = True }
 
   step "Recreating the database (schema version 1, one table is missing PK)..."
 
@@ -860,14 +856,15 @@ testCaseSteps' testName connSource f =
   let step s = liftIO $ step' s
   withSimpleStdOutLogger $ \logger ->
     runLogT "hpqtypes-extras-test" logger $
-    runDBT connSource {- transactionSettings -} def $
+    runDBT connSource defaultTransactionSettings $
     f step
 
 main :: IO ()
 main = do
   defaultMainWithIngredients ings $
     askOption $ \(ConnectionString connectionString) ->
-    let connSettings = def { csConnInfo = T.pack connectionString }
+    let connSettings = defaultConnectionSettings
+                       { csConnInfo = T.pack connectionString }
         ConnectionSource connSource = simpleSource connSettings
     in
     testGroup "DB tests" [ migrationTest1 connSource