Merge pull request #23 from scrive/remove-default-instances

Remove the Default instance for ExtrasOptions.
scrive · May 22, 2019 · aba2480 · aba2480
2 parents a8a25e3 + b61f8cc
commit aba2480
Show file tree

Hide file tree

Showing 5 changed files with 62 additions and 63 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,11 +1,15 @@
 # hpqtypes-extras-1.9.0.0 (2019-05-22)
-* Extend checkDatabaseAllowUnknownTables to allow unknown composite types and
-  rename it to checkDatabaseAllowUnknownObjects.
+* Extend `checkDatabaseAllowUnknownTables` to allow unknown composite
+  types and rename it to `checkDatabaseAllowUnknownObjects`
+  ([#22](https://github.com/scrive/hpqtypes-extras/pull/22)).
+* Remove the `Default` instance for `ExtrasOptions`; use
+  `defaultExtrasOptions` instead
+  ([#23](https://github.com/scrive/hpqtypes-extras/pull/23)).
 
 # 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)).
-* Add migration type for concurrent creation of an index
+* Add a migration type for concurrent creation of an index
   ([#21](https://github.com/scrive/hpqtypes-extras/pull/21)).
 
 # hpqtypes-extras-1.7.1.0 (2019-02-04)

diff --git a/hpqtypes-extras.cabal b/hpqtypes-extras.cabal
@@ -50,23 +50,22 @@ library
   other-modules:   Database.PostgreSQL.PQTypes.Checks.Util
                  , Database.PostgreSQL.PQTypes.Utils.NubList
 
-  build-depends: base > 4 && < 4.13
-               , hpqtypes >= 1.7.0.0
-               , base16-bytestring
-               , bytestring
-               , containers
-               , cryptohash
-               , data-default
-               , exceptions
-               , fields-json
-               , lifted-base
-               , log-base >= 0.7
-               , monad-control >= 1.0.0.0
-               , mtl
-               , safe
-               , semigroups >= 0.16
-               , text
-               , text-show
+  build-depends: base              >= 4       && < 4.13
+               , hpqtypes          >= 1.7.0.0 && < 1.8.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
+               , text              >= 1.2     && < 1.3
+               , lifted-base       >= 0.2     && < 0.3
+               , monad-control     >= 1.0     && < 1.1
+               , semigroups        >= 0.16    && < 0.20
+               , text-show         >= 3.8     && < 3.9
+               , log-base          >= 0.8     && < 0.9
+               , safe              >= 0.3     && < 0.4
 
   default-language: Haskell2010
   default-extensions: BangPatterns
@@ -101,7 +100,6 @@ test-suite  hpqtypes-extras-tests
                     , ScopedTypeVariables
   ghc-options:        -Wall
   build-depends:      base,
-                      data-default,
                       exceptions,
                       hpqtypes,
                       hpqtypes-extras,

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
@@ -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,18 @@
-module Database.PostgreSQL.PQTypes.ExtrasOptions (
-  ExtrasOptions(..)
+module Database.PostgreSQL.PQTypes.ExtrasOptions
+  ( ExtrasOptions(..)
+  , 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/test/Main.hs b/test/Main.hs
@@ -5,7 +5,6 @@ import Control.Exception.Lifted as E
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Control
 
-import Data.Default
 import Data.Monoid
 import Prelude
 import Data.Int
@@ -439,14 +438,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
@@ -530,27 +528,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
 
@@ -592,14 +588,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
@@ -644,14 +639,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
@@ -670,14 +664,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
@@ -754,7 +747,7 @@ migrationTest2 connSource =
         }
       currentSchema   = schema1Tables
       differentSchema = schema5Tables
-      extrasOptions = def { eoEnforcePKs = True }
+      extrasOptions   = defaultExtrasOptions { eoEnforcePKs = True }
 
   runQuery_ $ sqlCreateComposite composite
 
@@ -799,11 +792,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)..."
 
@@ -886,8 +881,7 @@ main = do
   defaultMainWithIngredients ings $
     askOption $ \(ConnectionString connectionString) ->
     let connSettings = defaultConnectionSettings
-          { csConnInfo = T.pack connectionString
-          }
+                       { csConnInfo = T.pack connectionString }
         ConnectionSource connSource = simpleSource connSettings
     in
     testGroup "DB tests" [ migrationTest1 connSource