diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for persistent-mysql +## 2.10.0 + +* Remove deprecated `SomeField` type and pattern synonym. Use `HandleUpdateCollision` type instead and the `copyField` function instead of `SomeField` constructor/pattern. [#894](https://github.com/yesodweb/persistent/pull/894) + ## 2.9.0 * Added support for SQL isolation levels to via SqlBackend. [#812] diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -- | A MySQL backend for @persistent@. module Database.Persist.MySQL ( withMySQLPool @@ -21,12 +19,8 @@ -- * @ON DUPLICATE KEY UPDATE@ Functionality , insertOnDuplicateKeyUpdate , insertManyOnDuplicateKeyUpdate -#if MIN_VERSION_base(4,7,0) , HandleUpdateCollision , pattern SomeField -#elif MIN_VERSION_base(4,9,0) - , HandleUpdateCollision(SomeField) -#endif , SomeField , copyField , copyUnlessNull @@ -34,65 +28,63 @@ , copyUnlessEq ) where +import qualified Blaze.ByteString.Builder.Char8 as BBB +import qualified Blaze.ByteString.Builder.ByteString as BBS + import Control.Arrow import Control.Monad -import Control.Monad.Logger (MonadLogger, runNoLoggingT) import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Monad.Logger (MonadLogger, runNoLoggingT) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Reader (runReaderT, ReaderT) import Control.Monad.Trans.Writer (runWriterT) -import Data.Either (partitionEithers) -import Data.Monoid ((<>)) -import qualified Data.Monoid as Monoid + +import Data.Conduit +import qualified Data.Conduit.List as CL +import Data.Acquire (Acquire, mkAcquire, with) import Data.Aeson import Data.Aeson.Types (modifyFailure) import Data.ByteString (ByteString) +import Data.Either (partitionEithers) import Data.Fixed (Pico) import Data.Function (on) +import Data.Int (Int64) import Data.IORef import Data.List (find, intercalate, sort, groupBy) +import qualified Data.Map as Map +import Data.Monoid ((<>)) +import qualified Data.Monoid as Monoid import Data.Pool (Pool) import Data.Text (Text, pack) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import Text.Read (readMaybe) import System.Environment (getEnvironment) -import Data.Acquire (Acquire, mkAcquire, with) -import Data.Conduit -import qualified Blaze.ByteString.Builder.Char8 as BBB -import qualified Blaze.ByteString.Builder.ByteString as BBS -import qualified Data.Conduit.List as CL -import qualified Data.Map as Map -import qualified Data.Text as T -import qualified Data.Text.Encoding as T - import Database.Persist.Sql -import Database.Persist.Sql.Types.Internal (mkPersistBackend, makeIsolationLevelStatement) +import Database.Persist.Sql.Types.Internal (makeIsolationLevelStatement) import qualified Database.Persist.Sql.Util as Util -import Data.Int (Int64) +import qualified Database.MySQL.Base as MySQLBase +import qualified Database.MySQL.Base.Types as MySQLBase import qualified Database.MySQL.Simple as MySQL import qualified Database.MySQL.Simple.Param as MySQL import qualified Database.MySQL.Simple.Result as MySQL import qualified Database.MySQL.Simple.Types as MySQL -import qualified Database.MySQL.Base as MySQLBase -import qualified Database.MySQL.Base.Types as MySQLBase -import Control.Monad.IO.Unlift (MonadUnliftIO) - -import Prelude - -- | Create a MySQL connection pool and run the given action. -- The pool is properly released after the action finishes using -- it. Note that you should not use the given 'ConnectionPool' -- outside the action since it may be already been released. -withMySQLPool :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend) +withMySQLPool :: (MonadLogger m, MonadUnliftIO m) => MySQL.ConnectInfo -- ^ Connection information. -> Int -- ^ Number of connections to be kept open in the pool. - -> (Pool backend -> m a) + -> (Pool SqlBackend -> m a) -- ^ Action to be executed that uses the connection pool. -> m a withMySQLPool ci = withSqlPool $ open' ci @@ -101,21 +93,21 @@ -- | Create a MySQL connection pool. Note that it's your -- responsibility to properly close the connection pool when -- unneeded. Use 'withMySQLPool' for automatic resource control. -createMySQLPool :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend) +createMySQLPool :: (MonadUnliftIO m, MonadLogger m) => MySQL.ConnectInfo -- ^ Connection information. -> Int -- ^ Number of connections to be kept open in the pool. - -> m (Pool backend) + -> m (Pool SqlBackend) createMySQLPool ci = createSqlPool $ open' ci -- | Same as 'withMySQLPool', but instead of opening a pool -- of connections, only one connection is opened. -withMySQLConn :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend) +withMySQLConn :: (MonadUnliftIO m, MonadLogger m) => MySQL.ConnectInfo -- ^ Connection information. - -> (backend -> m a) + -> (SqlBackend -> m a) -- ^ Action to be executed that uses the connection. -> m a withMySQLConn = withSqlConn . open' @@ -123,12 +115,12 @@ -- | Internal function that opens a connection to the MySQL -- server. -open' :: (IsSqlBackend backend) => MySQL.ConnectInfo -> LogFunc -> IO backend +open' :: MySQL.ConnectInfo -> LogFunc -> IO SqlBackend open' ci logFunc = do conn <- MySQL.connect ci MySQLBase.autocommit conn False -- disable autocommit! smap <- newIORef $ Map.empty - return . mkPersistBackend $ SqlBackend + return $ SqlBackend { connPrepare = prepare' conn , connStmtMap = smap , connInsertSql = insertSql' @@ -245,6 +237,7 @@ MySQL.Plain $ BBB.fromString $ show (fromRational r :: Pico) -- FIXME: Too Ambigous, can not select precision without information about field render (P (PersistDbSpecific s)) = MySQL.Plain $ BBS.fromByteString s + render (P (PersistArray a)) = MySQL.render (P (PersistList a)) render (P (PersistObjectId _)) = error "Refusing to serialize a PersistObjectId to a MySQL value" @@ -1075,7 +1068,7 @@ -- @INSERT ... ON DUPLICATE KEY UPDATE@ functionality, exposed via -- 'insertManyOnDuplicateKeyUpdate' in this library. -- --- @since 3.0.0 +-- @since 2.8.0 data HandleUpdateCollision record where -- | Copy the field directly from the record. CopyField :: EntityField record typ -> HandleUpdateCollision record @@ -1089,9 +1082,7 @@ -- @since 2.6.2 type SomeField = HandleUpdateCollision -#if MIN_VERSION_base(4,8,0) pattern SomeField :: EntityField record typ -> SomeField record -#endif pattern SomeField x = CopyField x {-# DEPRECATED SomeField "The type SomeField is deprecated. Use the type HandleUpdateCollision instead, and use the function copyField instead of the data constructor." #-} diff --git a/persistent-mysql.cabal b/persistent-mysql.cabal --- a/persistent-mysql.cabal +++ b/persistent-mysql.cabal @@ -1,5 +1,5 @@ name: persistent-mysql -version: 2.9.0 +version: 2.10.0 license: MIT license-file: LICENSE author: Felipe Lessa , Michael Snoyman @@ -7,7 +7,7 @@ synopsis: Backend for the persistent library using MySQL database server. category: Database, Yesod stability: Stable -cabal-version: >= 1.6 +cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/book/persistent bug-reports: https://github.com/yesodweb/persistent/issues @@ -27,24 +27,55 @@ extra-source-files: ChangeLog.md library - build-depends: base >= 4.8 && < 5 - , transformers >= 0.2.1 - , mysql-simple >= 0.4.3 && < 0.5 - , mysql >= 0.1.1.3 && < 0.2 + build-depends: base >= 4.9 && < 5 + , persistent >= 2.10.0 && < 3 + , aeson >= 1.0 , blaze-builder - , persistent >= 2.9.0 && < 3 - , containers >= 0.2 - , bytestring >= 0.9 - , text >= 0.11.0.6 - , unliftio-core - , aeson >= 0.6.2 - , conduit >= 1.2.8 - , resourcet >= 0.4.10 + , bytestring >= 0.10.8 + , conduit >= 1.2.12 + , containers >= 0.5 , monad-logger + , mysql >= 0.1.4 && < 0.2 + , mysql-simple >= 0.4.4 && < 0.5 + , resourcet >= 1.1 , resource-pool + , text >= 1.2 + , transformers >= 0.5 + , unliftio-core exposed-modules: Database.Persist.MySQL ghc-options: -Wall + default-language: Haskell2010 source-repository head type: git location: git://github.com/yesodweb/persistent.git + +test-suite test + type: exitcode-stdio-1.0 + main-is: main.hs + hs-source-dirs: test + other-modules: MyInit + InsertDuplicateUpdate + ghc-options: -Wall + + build-depends: base >= 4.9 && < 5 + , persistent + , persistent-mysql + , persistent-qq + , persistent-template + , persistent-test + , bytestring + , containers + , fast-logger + , hspec >= 2.4 + , HUnit + , monad-logger + , mysql + , QuickCheck + , quickcheck-instances + , resourcet + , text + , time + , transformers + , unliftio-core + default-language: Haskell2010 diff --git a/test/InsertDuplicateUpdate.hs b/test/InsertDuplicateUpdate.hs new file mode 100644 --- /dev/null +++ b/test/InsertDuplicateUpdate.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module InsertDuplicateUpdate where + +import Data.List (sort) + +import Database.Persist.MySQL +import MyInit + +share [mkPersist sqlSettings, mkMigrate "duplicateMigrate"] [persistUpperCase| + Item + name Text sqltype=varchar(80) + description Text + price Double Maybe + quantity Int Maybe + + Primary name + deriving Eq Show Ord + +|] + +specs :: Spec +specs = describe "DuplicateKeyUpdate" $ do + let item1 = Item "item1" "" (Just 3) Nothing + item2 = Item "item2" "hello world" Nothing (Just 2) + items = [item1, item2] + describe "insertOnDuplicateKeyUpdate" $ do + it "inserts appropriately" $ db $ do + deleteWhere ([] :: [Filter Item]) + insertOnDuplicateKeyUpdate item1 [ItemDescription =. "i am item 1"] + Just item <- get (ItemKey "item1") + item @== item1 + + it "performs only updates given if record already exists" $ db $ do + deleteWhere ([] :: [Filter Item]) + let newDescription = "I am a new description" + _ <- insert item1 + insertOnDuplicateKeyUpdate + (Item "item1" "i am inserted description" (Just 1) (Just 2)) + [ItemDescription =. newDescription] + Just item <- get (ItemKey "item1") + item @== item1 { itemDescription = newDescription } + + describe "insertManyOnDuplicateKeyUpdate" $ do + it "inserts fresh records" $ db $ do + deleteWhere ([] :: [Filter Item]) + insertMany_ items + let newItem = Item "item3" "fresh" Nothing Nothing + insertManyOnDuplicateKeyUpdate + (newItem : items) + [copyField ItemDescription] + [] + dbItems <- map entityVal <$> selectList [] [] + sort dbItems @== sort (newItem : items) + it "updates existing records" $ db $ do + deleteWhere ([] :: [Filter Item]) + insertMany_ items + insertManyOnDuplicateKeyUpdate + items + [] + [ItemQuantity +=. Just 1] + it "only copies passing values" $ db $ do + deleteWhere ([] :: [Filter Item]) + insertMany_ items + let newItems = map (\i -> i { itemQuantity = Just 0, itemPrice = fmap (*2) (itemPrice i) }) items + postUpdate = map (\i -> i { itemPrice = fmap (*2) (itemPrice i) }) items + insertManyOnDuplicateKeyUpdate + newItems + [ copyUnlessEq ItemQuantity (Just 0) + , copyField ItemPrice + ] + [] + dbItems <- sort . fmap entityVal <$> selectList [] [] + dbItems @== sort postUpdate + it "inserts without modifying existing records if no updates specified" $ db $ do + let newItem = Item "item3" "hi friends!" Nothing Nothing + deleteWhere ([] :: [Filter Item]) + insertMany_ items + insertManyOnDuplicateKeyUpdate + (newItem : items) + [] + [] + dbItems <- sort . fmap entityVal <$> selectList [] [] + dbItems @== sort (newItem : items) diff --git a/test/MyInit.hs b/test/MyInit.hs new file mode 100644 --- /dev/null +++ b/test/MyInit.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE OverloadedStrings #-} + +module MyInit ( + (@/=), (@==), (==@) + , asIO + , assertNotEqual + , assertNotEmpty + , assertEmpty + , isTravis + , BackendMonad + , runConn + + , MonadIO + , persistSettings + , MkPersistSettings (..) + , db + , BackendKey(..) + , GenerateKey(..) + + , RunDb + -- re-exports + , module Database.Persist + , module Database.Persist.Sql.Raw.QQ + , module Test.Hspec + , module Test.HUnit + , liftIO + , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase + , Int32, Int64 + , Text + , module Control.Monad.Trans.Reader + , module Control.Monad + , module Database.Persist.Sql + , BS.ByteString + , SomeException + , MonadFail + , TestFn(..) + , truncateTimeOfDay + , truncateToMicro + , truncateUTCTime + , arbText + , liftA2 + ) where + +import Init + ( TestFn(..), truncateTimeOfDay, truncateUTCTime + , truncateToMicro, arbText, GenerateKey(..) + , (@/=), (@==), (==@) + , assertNotEqual, assertNotEmpty, assertEmpty, asIO + , isTravis, RunDb, MonadFail + ) + +-- re-exports +import Control.Applicative (liftA2) +import Control.Exception (SomeException) +import Control.Monad (void, replicateM, liftM, when, forM_) +import Control.Monad.Trans.Reader +import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..)) +import Database.Persist.Sql.Raw.QQ +import Test.Hspec +import Test.QuickCheck.Instances () + +-- testing +import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool) + +import Control.Monad (unless, (>=>)) +import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Monad.IO.Class +import Control.Monad.Logger +import Control.Monad.Trans.Resource (ResourceT, runResourceT) +import qualified Data.ByteString as BS +import Data.Int (Int32, Int64) +import Data.Text (Text) +import qualified Database.MySQL.Base as MySQL +import System.Log.FastLogger (fromLogStr) + +import Database.Persist +import Database.Persist.MySQL +import Database.Persist.Sql +import Database.Persist.TH () + +_debugOn :: Bool +_debugOn = False + +persistSettings :: MkPersistSettings +persistSettings = sqlSettings { mpsGeneric = True } + +type BackendMonad = SqlBackend + +runConn :: MonadUnliftIO m => SqlPersistT (LoggingT m) t -> m () +runConn f = do + travis <- liftIO isTravis + let debugPrint = not travis && _debugOn + let printDebug = if debugPrint then print . fromLogStr else void . return + flip runLoggingT (\_ _ _ s -> printDebug s) $ do + -- Since version 5.7.5, MySQL adds a mode value `STRICT_TRANS_TABLES` + -- which can cause an exception in MaxLenTest, depending on the server + -- configuration. Persistent tests do not need any of the modes which are + -- set by default, so it is simplest to clear `sql_mode` for the session. + let baseConnectInfo = + defaultConnectInfo { + connectOptions = + connectOptions defaultConnectInfo + ++ [MySQL.InitCommand "SET SESSION sql_mode = '';\0"] + } + _ <- if not travis + then withMySQLPool baseConnectInfo + { connectHost = "localhost" + , connectUser = "test" + , connectPassword = "test" + , connectDatabase = "test" + } 1 $ runSqlPool f + else withMySQLPool baseConnectInfo + { connectHost = "localhost" + , connectUser = "travis" + , connectPassword = "" + , connectDatabase = "persistent" + } 1 $ runSqlPool f + return () + +db :: SqlPersistT (LoggingT (ResourceT IO)) () -> Assertion +db actions = do + runResourceT $ runConn $ actions >> transactionUndo diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + +import MyInit + +import Data.Time (Day, UTCTime (..), TimeOfDay, timeToTimeOfDay, timeOfDayToTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime) +import Data.Fixed +import Test.QuickCheck +import qualified Data.Text as T +import Data.IntMap (IntMap) +import qualified Data.ByteString as BS + +import qualified CompositeTest +import qualified CustomPersistFieldTest +import qualified CustomPrimaryKeyReferenceTest +import qualified DataTypeTest +import qualified EmbedOrderTest +import qualified EmbedTest +import qualified EmptyEntityTest +import qualified EquivalentTypeTest +import qualified HtmlTest +import qualified InsertDuplicateUpdate +import qualified LargeNumberTest +import qualified MaxLenTest +import qualified MigrationColumnLengthTest +import qualified MigrationIdempotencyTest +import qualified MigrationOnlyTest +import qualified MpsNoPrefixTest +import qualified PersistentTest +import qualified PersistUniqueTest +-- FIXME: Not used... should it be? +-- import qualified PrimaryTest +import qualified RawSqlTest +import qualified ReadWriteTest +import qualified Recursive +import qualified RenameTest +import qualified SumTypeTest +import qualified TransactionLevelTest +import qualified UniqueTest +import qualified UpsertTest + +type Tuple a b = (a, b) + +-- Test lower case names +share [mkPersist persistSettings, mkMigrate "dataTypeMigrate"] [persistLowerCase| +DataTypeTable no-json + text Text + textMaxLen Text maxlen=100 + bytes ByteString + bytesTextTuple (Tuple ByteString Text) + bytesMaxLen ByteString maxlen=100 + int Int + intList [Int] + intMap (IntMap Int) + double Double + bool Bool + day Day + pico Pico + time TimeOfDay + utc UTCTime + -- For MySQL, provide extra tests for time fields with fractional seconds, + -- since the default (used above) is to have no fractional part. This + -- requires the server version to be at least 5.6.4, and should be switched + -- off for older servers by defining OLD_MYSQL. + timeFrac TimeOfDay sqltype=TIME(6) + utcFrac UTCTime sqltype=DATETIME(6) +|] + +instance Arbitrary (DataTypeTableGeneric backend) where + arbitrary = DataTypeTable + <$> arbText -- text + <*> (T.take 100 <$> arbText) -- textManLen + <*> arbitrary -- bytes + <*> liftA2 (,) arbitrary arbText -- bytesTextTuple + <*> (BS.take 100 <$> arbitrary) -- bytesMaxLen + <*> arbitrary -- int + <*> arbitrary -- intList + <*> arbitrary -- intMap + <*> arbitrary -- double + <*> arbitrary -- bool + <*> arbitrary -- day + <*> arbitrary -- pico + <*> (truncateTimeOfDay =<< arbitrary) -- time + <*> (truncateUTCTime =<< arbitrary) -- utc + <*> (truncateTimeOfDay =<< arbitrary) -- timeFrac + <*> (truncateUTCTime =<< arbitrary) -- utcFrac + +setup :: MonadIO m => Migration -> ReaderT SqlBackend m () +setup migration = do + printMigration migration + runMigrationUnsafe migration + +main :: IO () +main = do + runConn $ do + mapM_ setup + [ PersistentTest.testMigrate + , PersistentTest.noPrefixMigrate + , EmbedTest.embedMigrate + , EmbedOrderTest.embedOrderMigrate + , LargeNumberTest.numberMigrate + , UniqueTest.uniqueMigrate + , MaxLenTest.maxlenMigrate + , Recursive.recursiveMigrate + , CompositeTest.compositeMigrate + , PersistUniqueTest.migration + , RenameTest.migration + , CustomPersistFieldTest.customFieldMigrate + , InsertDuplicateUpdate.duplicateMigrate + , MigrationIdempotencyTest.migration + , CustomPrimaryKeyReferenceTest.migration + , MigrationColumnLengthTest.migration + , TransactionLevelTest.migration + ] + PersistentTest.cleanDB + + hspec $ do + RenameTest.specsWith db + DataTypeTest.specsWith + db + (Just (runMigrationSilent dataTypeMigrate)) + [ TestFn "text" dataTypeTableText + , TestFn "textMaxLen" dataTypeTableTextMaxLen + , TestFn "bytes" dataTypeTableBytes + , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple + , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen + , TestFn "int" dataTypeTableInt + , TestFn "intList" dataTypeTableIntList + , TestFn "intMap" dataTypeTableIntMap + , TestFn "bool" dataTypeTableBool + , TestFn "day" dataTypeTableDay + , TestFn "time" (roundTime . dataTypeTableTime) + , TestFn "utc" (roundUTCTime . dataTypeTableUtc) + , TestFn "timeFrac" (dataTypeTableTimeFrac) + , TestFn "utcFrac" (dataTypeTableUtcFrac) + ] + [ ("pico", dataTypeTablePico) ] + dataTypeTableDouble + HtmlTest.specsWith + db + (Just (runMigrationSilent HtmlTest.htmlMigrate)) + EmbedTest.specsWith db + EmbedOrderTest.specsWith db + LargeNumberTest.specsWith db + UniqueTest.specsWith db + MaxLenTest.specsWith db + Recursive.specsWith db + SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate)) + MigrationOnlyTest.specsWith db + (Just + $ runMigrationSilent MigrationOnlyTest.migrateAll1 + >> runMigrationSilent MigrationOnlyTest.migrateAll2 + ) + PersistentTest.specsWith db + PersistentTest.filterOrSpecs db + ReadWriteTest.specsWith db + RawSqlTest.specsWith db + UpsertTest.specsWith + db + UpsertTest.Don'tUpdateNull + UpsertTest.UpsertPreserveOldKey + + MpsNoPrefixTest.specsWith db + EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration)) + CompositeTest.specsWith db + PersistUniqueTest.specsWith db + CustomPersistFieldTest.specsWith db + CustomPrimaryKeyReferenceTest.specsWith db + InsertDuplicateUpdate.specs + MigrationColumnLengthTest.specsWith db + EquivalentTypeTest.specsWith db + TransactionLevelTest.specsWith db + + MigrationIdempotencyTest.specsWith db + +roundFn :: RealFrac a => a -> Integer +roundFn = round + +roundTime :: TimeOfDay -> TimeOfDay +roundTime t = timeToTimeOfDay $ fromIntegral $ roundFn $ timeOfDayToTime t + +roundUTCTime :: UTCTime -> UTCTime +roundUTCTime t = + posixSecondsToUTCTime $ fromIntegral $ roundFn $ utcTimeToPOSIXSeconds t