persistent-sqlite 2.12.0.0 → 2.13.0.0
raw patch · 6 files changed
+318/−286 lines, 6 filesdep ~basedep ~persistent
Dependency ranges changed: base, persistent
Files
- ChangeLog.md +5/−0
- Database/Persist/Sqlite.hs +89/−89
- persistent-sqlite.cabal +5/−3
- test/Database/Persist/Sqlite/CompositeSpec.hs +94/−0
- test/SqliteInit.hs +10/−7
- test/main.hs +115/−187
ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for persistent-sqlite +## 2.13.0.0++* [#1225](https://github.com/yesodweb/persistent/pull/1225)+ * Support `persistent-2.13` changes for SqlBackend being made internal.+ ## 2.12.0.0 * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174)
Database/Persist/Sqlite.hs view
@@ -11,12 +11,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}+ -- Strictly, this could go as low as GHC 8.6.1, which is when DerivingVia was -- introduced - this base version requires 8.6.5+ #if MIN_VERSION_base(4,12,0) {-# LANGUAGE DerivingVia #-} {-# LANGUAGE UndecidableInstances #-} #endif+ -- | A sqlite backend for persistent. -- -- Note: If you prepend @WAL=off @ to your connection string, it will disable@@ -78,18 +80,19 @@ import Data.Int (Int64) import Data.IORef import qualified Data.Map as Map-import Data.Monoid ((<>)) import Data.Pool (Pool) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Lens.Micro.TH (makeLenses) import UnliftIO.Resource (ResourceT, runResourceT)+import Data.Foldable (toList) #if MIN_VERSION_base(4,12,0) import Database.Persist.Compatible #endif import Database.Persist.Sql+import Database.Persist.SqlBackend import qualified Database.Persist.Sql.Util as Util import qualified Database.Sqlite as Sqlite @@ -267,28 +270,27 @@ Sqlite.finalize stmt smap <- newIORef $ Map.empty- return $ SqlBackend- { connPrepare = prepare' conn- , connStmtMap = smap- , connInsertSql = insertSql'- , connUpsertSql = Nothing- , connPutManySql = Just putManySql- , connInsertManySql = Nothing- , connClose = Sqlite.close conn- , connMigrateSql = migrate'- , connBegin = \f _ -> helper "BEGIN" f- , connCommit = helper "COMMIT"- , connRollback = ignoreExceptions . helper "ROLLBACK"- , connEscapeFieldName = escape . unFieldNameDB- , connEscapeTableName = escape . unEntityNameDB . entityDB- , connEscapeRawName = escape- , connNoLimit = "LIMIT -1"- , connRDBMS = "sqlite"- , connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"- , connLogFunc = logFunc- , connMaxParams = Just 999- , connRepsertManySql = Just repsertManySql- }+ return $+ setConnMaxParams 999 $+ setConnPutManySql putManySql $+ setConnRepsertManySql repsertManySql $+ mkSqlBackend MkSqlBackendArgs+ { connPrepare = prepare' conn+ , connStmtMap = smap+ , connInsertSql = insertSql'+ , connClose = Sqlite.close conn+ , connMigrateSql = migrate'+ , connBegin = \f _ -> helper "BEGIN" f+ , connCommit = helper "COMMIT"+ , connRollback = ignoreExceptions . helper "ROLLBACK"+ , connEscapeFieldName = escape . unFieldNameDB+ , connEscapeTableName = escape . unEntityNameDB . getEntityDBName+ , connEscapeRawName = escape+ , connNoLimit = "LIMIT -1"+ , connRDBMS = "sqlite"+ , connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"+ , connLogFunc = logFunc+ } where helper t getter = do stmt <- getter t@@ -336,31 +338,31 @@ insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult insertSql' ent vals =- case entityPrimary ent of- Just _ ->+ case getEntityId ent of+ EntityIdNaturalKey _ -> ISRManyKeys sql vals where sql = T.concat [ "INSERT INTO "- , escapeE $ entityDB ent+ , escapeE $ getEntityDBName ent , "(" , T.intercalate "," $ map (escapeF . fieldDB) cols , ") VALUES(" , T.intercalate "," (map (const "?") cols) , ")" ]- Nothing ->+ EntityIdField fd -> ISRInsertGet ins sel where sel = T.concat [ "SELECT "- , escapeF $ fieldDB (entityId ent)+ , escapeF $ fieldDB fd , " FROM "- , escapeE $ entityDB ent+ , escapeE $ getEntityDBName ent , " WHERE _ROWID_=last_insert_rowid()" ] ins = T.concat [ "INSERT INTO "- , escapeE $ entityDB ent+ , escapeE $ getEntityDBName ent , if null cols then " VALUES(null)" else T.concat@@ -375,7 +377,7 @@ notGenerated = isNothing . fieldGenerated cols =- filter notGenerated $ entityFields ent+ filter notGenerated $ getEntityFields ent execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64 execute' conn stmt vals = flip finally (liftIO $ Sqlite.reset conn stmt) $ do@@ -441,7 +443,7 @@ return $ Right sql where def = val- table = entityDB def+ table = getEntityDBName def go = do x <- CL.head case x of@@ -454,44 +456,42 @@ -- with the difference that an actual database isn't needed for it. mockMigration :: Migration -> IO () mockMigration mig = do- smap <- newIORef $ Map.empty- let sqlbackend = SqlBackend- { connPrepare = \_ -> do- return Statement- { stmtFinalize = return ()- , stmtReset = return ()- , stmtExecute = undefined- , stmtQuery = \_ -> return $ return ()- }- , connStmtMap = smap- , connInsertSql = insertSql'- , connInsertManySql = Nothing- , connClose = undefined- , connMigrateSql = migrate'- , connBegin = \f _ -> helper "BEGIN" f- , connCommit = helper "COMMIT"- , connRollback = ignoreExceptions . helper "ROLLBACK"- , connEscapeFieldName = escape . unFieldNameDB- , connEscapeTableName = escape . unEntityNameDB . entityDB- , connEscapeRawName = escape- , connNoLimit = "LIMIT -1"- , connRDBMS = "sqlite"- , connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"- , connLogFunc = undefined- , connUpsertSql = undefined- , connPutManySql = undefined- , connMaxParams = Just 999- , connRepsertManySql = Nothing- }- result = runReaderT . runWriterT . runWriterT $ mig- resp <- result sqlbackend- mapM_ TIO.putStrLn $ map snd $ snd resp- where- helper t getter = do- stmt <- getter t- _ <- stmtExecute stmt []- stmtReset stmt- ignoreExceptions = E.handle (\(_ :: E.SomeException) -> return ())+ smap <- newIORef $ Map.empty+ let sqlbackend =+ setConnMaxParams 999 $+ mkSqlBackend MkSqlBackendArgs+ { connPrepare = \_ -> do+ return Statement+ { stmtFinalize = return ()+ , stmtReset = return ()+ , stmtExecute = undefined+ , stmtQuery = \_ -> return $ return ()+ }+ , connStmtMap = smap+ , connInsertSql = insertSql'+ , connClose = undefined+ , connMigrateSql = migrate'+ , connBegin = \f _ -> helper "BEGIN" f+ , connCommit = helper "COMMIT"+ , connRollback = ignoreExceptions . helper "ROLLBACK"+ , connEscapeFieldName = escape . unFieldNameDB+ , connEscapeTableName = escape . unEntityNameDB . getEntityDBName+ , connEscapeRawName = escape+ , connNoLimit = "LIMIT -1"+ , connRDBMS = "sqlite"+ , connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"+ , connLogFunc = undefined+ }+ result = runReaderT . runWriterT . runWriterT $ mig+ resp <- result sqlbackend+ mapM_ TIO.putStrLn $ map snd $ snd resp+ where+ helper t getter = do+ stmt <- getter t+ _ <- stmtExecute stmt []+ stmtReset stmt+ ignoreExceptions =+ E.handle (\(_ :: E.SomeException) -> return ()) -- | Check if a column name is listed as the "safe to remove" in the entity -- list.@@ -499,7 +499,7 @@ safeToRemove def (FieldNameDB colName) = any (elem FieldAttrSafeToRemove . fieldAttrs) $ filter ((== FieldNameDB colName) . fieldDB)- $ entityFields def+ $ getEntityFieldsDatabase def getCopyTable :: [EntityDef] -> (Text -> IO Statement)@@ -527,12 +527,12 @@ names <- getCols return $ name : names Just y -> error $ "Invalid result from PRAGMA table_info: " ++ show y- table = entityDB def+ table = getEntityDBName def tableTmp = EntityNameDB $ unEntityNameDB table <> "_backup" (cols, uniqs, fdef) = sqliteMkColumns allDefs def cols' = filter (not . safeToRemove def . cName) cols newSql = mkCreateTable False def (cols', uniqs, fdef)- tmpSql = mkCreateTable True def { entityDB = tableTmp } (cols', uniqs, [])+ tmpSql = mkCreateTable True (setEntityDBName tableTmp def) (cols', uniqs, []) dropTmp = "DROP TABLE " <> escapeE tableTmp dropOld = "DROP TABLE " <> escapeE table copyToTemp common = T.concat@@ -562,7 +562,7 @@ [ "CREATE" , if isTemp then " TEMP" else "" , " TABLE "- , escapeE $ entityDB entity+ , escapeE $ getEntityDBName entity , "(" ] @@ -572,25 +572,25 @@ , ")" ] - columns = case entityPrimary entity of- Just pdef ->+ columns = case getEntityId entity of+ EntityIdNaturalKey pdef -> [ T.drop 1 $ T.concat $ map (sqlColumn isTemp) cols , ", PRIMARY KEY " , "("- , T.intercalate "," $ map (escapeF . fieldDB) $ compositeFields pdef+ , T.intercalate "," $ map (escapeF . fieldDB) $ toList $ compositeFields pdef , ")" ] - Nothing ->- [ escapeF $ fieldDB (entityId entity)+ EntityIdField fd ->+ [ escapeF $ fieldDB fd , " "- , showSqlType $ fieldSqlType $ entityId entity+ , showSqlType $ fieldSqlType fd , " PRIMARY KEY"- , mayDefault $ defaultAttribute $ fieldAttrs $ entityId entity+ , mayDefault $ defaultAttribute $ fieldAttrs fd , T.concat $ map (sqlColumn isTemp) nonIdCols ] - nonIdCols = filter (\c -> cName c /= fieldDB (entityId entity)) cols+ nonIdCols = filter (\c -> Just (cName c) /= fmap fieldDB (getEntityIdField entity)) cols mayDefault :: Maybe Text -> Text mayDefault def = case def of@@ -652,7 +652,7 @@ [ ",CONSTRAINT " , escapeC cname , " UNIQUE ("- , T.intercalate "," $ map (escapeF . snd) cols+ , T.intercalate "," $ map (escapeF . snd) $ toList cols , ")" ] @@ -674,16 +674,16 @@ go c = T.singleton c putManySql :: EntityDef -> Int -> Text-putManySql ent n = putManySql' conflictColumns fields ent n+putManySql ent n = putManySql' conflictColumns (toList fields) ent n where- fields = entityFields ent- conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (entityUniques ent)+ fields = getEntityFieldsDatabase ent+ conflictColumns = concatMap (map (escapeF . snd) . toList . uniqueFields) (getEntityUniques ent) repsertManySql :: EntityDef -> Int -> Text-repsertManySql ent n = putManySql' conflictColumns fields ent n+repsertManySql ent n = putManySql' conflictColumns (toList fields) ent n where fields = keyAndEntityFields ent- conflictColumns = escapeF . fieldDB <$> entityKeyFields ent+ conflictColumns = escapeF . fieldDB <$> toList (getEntityKeyFields ent) putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text putManySql' conflictColumns fields ent n = q@@ -691,7 +691,7 @@ fieldDbToText = escapeF . fieldDB mkAssignment f = T.concat [f, "=EXCLUDED.", f] - table = escapeE . entityDB $ ent+ table = escapeE . getEntityDBName $ ent columns = Util.commaSeparated $ map fieldDbToText fields placeholders = map (const "?") fields updates = map (mkAssignment . fieldDbToText) fields
persistent-sqlite.cabal view
@@ -1,5 +1,5 @@ name: persistent-sqlite-version: 2.12.0.0+version: 2.13.0.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -44,7 +44,7 @@ library build-depends: base >= 4.9 && < 5- , persistent >= 2.12 && < 3+ , persistent >= 2.13 && < 3 , aeson >= 1.0 , bytestring >= 0.10 , conduit >= 1.2.12@@ -114,7 +114,9 @@ type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: test- other-modules: SqliteInit+ other-modules: + SqliteInit+ Database.Persist.Sqlite.CompositeSpec ghc-options: -Wall build-depends: base >= 4.9 && < 5
+ test/Database/Persist/Sqlite/CompositeSpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DerivingStrategies #-}+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++module Database.Persist.Sqlite.CompositeSpec where++import SqliteInit++import Control.Monad.Reader (MonadReader)+import Control.Monad.Trans.Resource (MonadResource)+import qualified Data.Conduit.List as CL+import Conduit+import Database.Persist.Sqlite+import System.IO (hClose)+import Control.Exception (handle, IOException, throwIO)+import System.IO.Temp (withSystemTempFile)+import qualified Data.Text as T+import qualified Lens.Micro as Lens++share [mkPersist sqlSettings, mkMigrate "compositeSetup"] [persistLowerCase|+SimpleComposite+ int Int+ text Text+ Primary text int+ deriving Show Eq++SimpleCompositeReference+ int Int+ text Text+ label Text+ Foreign SimpleComposite fk_simple_composite text int+ deriving Show Eq+|]++share [mkPersist sqlSettings, mkMigrate "compositeMigrateTest"] [persistLowerCase|+SimpleComposite2 sql=simple_composite+ int Int+ text Text+ new Int default=0+ Primary text int+ deriving Show Eq++SimpleCompositeReference2 sql=simple_composite_reference+ int Int+ text Text+ label Text+ Foreign SimpleComposite2 fk_simple_composite text int+ deriving Show Eq+|]++spec :: Spec+spec = describe "CompositeSpec" $ do+ it "properly migrates to a composite primary key (issue #669)" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do+ void $ runMigrationSilent compositeSetup+ void $ runMigrationSilent compositeMigrateTest+ pure ()+ it "test migrating sparse composite primary keys (issue #1184)" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do+ hClose h+ let connInfo = Lens.set fkEnabled False $ mkSqliteConnectionInfo (T.pack fp)++ runSqliteInfo connInfo $ do+ void $ runMigrationSilent compositeSetup+ forM_ [(1,"foo"),(3,"bar")] $ \(intKey, strKey) -> do+ let key = SimpleCompositeKey strKey intKey+ insertKey key (SimpleComposite intKey strKey)+ insert (SimpleCompositeReference intKey strKey "test")++ validateForeignKeys++ runSqliteInfo connInfo $ do+ void $ runMigrationSilent compositeMigrateTest+ validateForeignKeys+++validateForeignKeys+ :: (MonadResource m, MonadReader env m, BackendCompatible SqlBackend env)+ => m ()+validateForeignKeys = do+ violations <- map (T.pack . show) <$> runConduit (checkForeignKeys .| CL.consume)+ unless (null violations) . liftIO . throwIO $+ PersistForeignConstraintUnmet (T.unlines violations)
test/SqliteInit.hs view
@@ -84,21 +84,24 @@ persistSettings :: MkPersistSettings persistSettings = sqlSettings { mpsGeneric = True }+ type BackendMonad = SqlBackend sqlite_database_file :: Text sqlite_database_file = "testdb.sqlite3"+ sqlite_database :: SqliteConnectionInfo sqlite_database = mkSqliteConnectionInfo sqlite_database_file+ 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- _<-withSqlitePoolInfo sqlite_database 1 $ runSqlPool f- return ()+ travis <- liftIO isTravis+ let debugPrint = not travis && _debugOn+ let printDebug = if debugPrint then print . fromLogStr else void . return+ void $ flip runLoggingT (\_ _ _ s -> printDebug s) $ do+ withSqlitePoolInfo sqlite_database 1 $ runSqlPool f db :: SqlPersistT (LoggingT (ResourceT IO)) () -> Assertion db actions = do- runResourceT $ runConn $ actions >> transactionUndo+ runResourceT $ runConn $ actions >> transactionUndo+
test/main.hs view
@@ -70,6 +70,7 @@ import qualified Database.Sqlite as Sqlite import PersistentTestModels +import qualified Database.Persist.Sqlite.CompositeSpec as CompositeSpec import qualified MigrationTest type Tuple = (,)@@ -93,37 +94,6 @@ utc UTCTime |] -share [mkPersist sqlSettings, mkMigrate "compositeSetup"] [persistLowerCase|-SimpleComposite- int Int- text Text- Primary text int- deriving Show Eq--SimpleCompositeReference- int Int- text Text- label Text- Foreign SimpleComposite fk_simple_composite text int- deriving Show Eq-|]--share [mkPersist sqlSettings, mkMigrate "compositeMigrateTest"] [persistLowerCase|-SimpleComposite2 sql=simple_composite- int Int- text Text- new Int default=0- Primary text int- deriving Show Eq--SimpleCompositeReference2 sql=simple_composite_reference- int Int- text Text- label Text- Foreign SimpleComposite2 fk_simple_composite text int- deriving Show Eq-|]- share [mkPersist sqlSettings, mkMigrate "idSetup"] [persistLowerCase| Simple text Text@@ -176,165 +146,123 @@ main :: IO () main = do- handle (\(_ :: IOException) -> return ())- $ removeFile $ fromText sqlite_database_file+ handle (\(_ :: IOException) -> return ())+ $ removeFile $ fromText sqlite_database_file - runConn $ do- mapM_ setup- [ ForeignKey.compositeMigrate- , PersistentTest.testMigrate- , PersistentTest.noPrefixMigrate- , PersistentTest.customPrefixMigrate- , EmbedTest.embedMigrate- , EmbedOrderTest.embedOrderMigrate- , LargeNumberTest.numberMigrate- , UniqueTest.uniqueMigrate- , MaxLenTest.maxlenMigrate- , Recursive.recursiveMigrate- , CompositeTest.compositeMigrate- , MigrationTest.migrationMigrate- , PersistUniqueTest.migration- , RenameTest.migration- , CustomPersistFieldTest.customFieldMigrate- , PrimaryTest.migration- , CustomPrimaryKeyReferenceTest.migration- , MigrationColumnLengthTest.migration- , TransactionLevelTest.migration- , LongIdentifierTest.migration- ]- PersistentTest.cleanDB- ForeignKey.cleanDB+ runConn $ do+ mapM_ setup+ [ ForeignKey.compositeMigrate+ , PersistentTest.testMigrate+ , PersistentTest.noPrefixMigrate+ , PersistentTest.customPrefixMigrate+ , EmbedTest.embedMigrate+ , EmbedOrderTest.embedOrderMigrate+ , LargeNumberTest.numberMigrate+ , UniqueTest.uniqueMigrate+ , MaxLenTest.maxlenMigrate+ , Recursive.recursiveMigrate+ , CompositeTest.compositeMigrate+ , MigrationTest.migrationMigrate+ , PersistUniqueTest.migration+ , RenameTest.migration+ , CustomPersistFieldTest.customFieldMigrate+ , PrimaryTest.migration+ , CustomPrimaryKeyReferenceTest.migration+ , MigrationColumnLengthTest.migration+ , TransactionLevelTest.migration+ , LongIdentifierTest.migration+ ]+ PersistentTest.cleanDB+ ForeignKey.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" (DataTypeTest.roundTime . dataTypeTableTime)- , TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)- ]- [ ("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- MpsCustomPrefixTest.specsWith db- EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))- CompositeTest.specsWith db- PersistUniqueTest.specsWith db- PrimaryTest.specsWith db- CustomPersistFieldTest.specsWith db- CustomPrimaryKeyReferenceTest.specsWith db- MigrationColumnLengthTest.specsWith db- EquivalentTypeTest.specsWith db- ForeignKey.specsWith db- TransactionLevelTest.specsWith db- MigrationTest.specsWith db- LongIdentifierTest.specsWith db- GeneratedColumnTestSQL.specsWith db-- it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do- void $ runMigrationSilent migrateAll- insert_ . Test $ read "2014-11-30 05:15:25.123Z"- [Single x] <- rawSql "select strftime('%s%f',time) from test" []- liftIO $ x `shouldBe` Just ("141732452525.123" :: String)- it "issue #339" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do- void $ runMigrationSilent migrateAll- now <- liftIO getCurrentTime- tid <- insert $ Test now- Just (Test now') <- get tid- liftIO $ now' `shouldBe` now- it "issue #564" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do- hClose h- conn <- Sqlite.open (T.pack fp)- Sqlite.close conn- return ()- it "issue #527" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do- void $ runMigrationSilent migrateAll- insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123Z")-- it "properly migrates to a composite primary key (issue #669)" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do- void $ runMigrationSilent compositeSetup- void $ runMigrationSilent compositeMigrateTest- pure ()-- it "test migrating sparse primary keys (issue #1184)" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do- hClose h- let connInfo = Lens.set fkEnabled False $ mkSqliteConnectionInfo (T.pack fp)- runSqliteInfo connInfo $ do- void $ runMigrationSilent idSetup- forM_ (map toSqlKey [1,3]) $ \key -> do- insertKey key (Simple "foo")- insert (SimpleReference key "test")-- validateForeignKeys-- runSqliteInfo connInfo $ do- void $ runMigrationSilent idMigrateTest- validateForeignKeys-- it "test migrating sparse composite primary keys (issue #1184)" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do- hClose h- let connInfo = Lens.set fkEnabled False $ mkSqliteConnectionInfo (T.pack fp)-- runSqliteInfo connInfo $ do- void $ runMigrationSilent compositeSetup- forM_ [(1,"foo"),(3,"bar")] $ \(intKey, strKey) -> do- let key = SimpleCompositeKey strKey intKey- insertKey key (SimpleComposite intKey strKey)- insert (SimpleCompositeReference intKey strKey "test")-- validateForeignKeys+ hspec $ do+ describe "Database" $ describe "Persist" $ describe "Sqlite" $ do+ CompositeSpec.spec+ 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" (DataTypeTest.roundTime . dataTypeTableTime)+ , TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)+ ]+ [ ("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 - runSqliteInfo connInfo $ do- void $ runMigrationSilent compositeMigrateTest- validateForeignKeys+ MpsNoPrefixTest.specsWith db+ MpsCustomPrefixTest.specsWith db+ EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))+ CompositeTest.specsWith db+ PersistUniqueTest.specsWith db+ PrimaryTest.specsWith db+ CustomPersistFieldTest.specsWith db+ CustomPrimaryKeyReferenceTest.specsWith db+ MigrationColumnLengthTest.specsWith db+ EquivalentTypeTest.specsWith db+ ForeignKey.specsWith db+ TransactionLevelTest.specsWith db+ MigrationTest.specsWith db+ LongIdentifierTest.specsWith db+ GeneratedColumnTestSQL.specsWith db - it "afterException" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do- void $ runMigrationSilent testMigrate- let catcher :: forall m. Monad m => SomeException -> m ()- catcher _ = return ()- insert_ $ Person "A" 0 Nothing- insert_ (Person "A" 1 Nothing) `catch` catcher- insert_ $ Person "B" 0 Nothing- return ()+ it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do+ void $ runMigrationSilent migrateAll+ insert_ . Test $ read "2014-11-30 05:15:25.123Z"+ [Single x] <- rawSql "select strftime('%s%f',time) from test" []+ liftIO $ x `shouldBe` Just ("141732452525.123" :: String)+ it "issue #339" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do+ void $ runMigrationSilent migrateAll+ now <- liftIO getCurrentTime+ tid <- insert $ Test now+ Just (Test now') <- get tid+ liftIO $ now' `shouldBe` now+ it "issue #564" $ asIO $ withSystemTempFile "test564.sqlite3"$ \fp h -> do+ hClose h+ conn <- Sqlite.open (T.pack fp)+ Sqlite.close conn+ return ()+ it "issue #527" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do+ void $ runMigrationSilent migrateAll+ insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123Z") -validateForeignKeys- :: (MonadResource m, MonadReader env m, BackendCompatible SqlBackend env)- => m ()-validateForeignKeys = do- violations <- map (T.pack . show) <$> runConduit (checkForeignKeys .| CL.consume)- unless (null violations) . liftIO . throwIO $- PersistForeignConstraintUnmet (T.unlines violations)+ it "afterException" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do+ void $ runMigrationSilent testMigrate+ let catcher :: forall m. Monad m => SomeException -> m ()+ catcher _ = return ()+ insert_ $ Person "A" 0 Nothing+ insert_ (Person "A" 1 Nothing) `catch` catcher+ insert_ $ Person "B" 0 Nothing+ return ()