Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-persistent-sqlite for
openSUSE:Factory checked in at 2021-05-11 23:04:10
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent-sqlite (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.2988 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-sqlite"
Tue May 11 23:04:10 2021 rev:7 rq:892190 version:2.13.0.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-persistent-sqlite/ghc-persistent-sqlite.changes
2021-04-10 15:28:22.314448655 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.2988/ghc-persistent-sqlite.changes
2021-05-11 23:04:16.644925652 +0200
@@ -1,0 +2,15 @@
+Sat May 8 10:03:32 UTC 2021 - psim...@suse.com
+
+- Update persistent-sqlite to version 2.13.0.0 revision 1.
+ Upstream has revised the Cabal build instructions on Hackage.
+
+-------------------------------------------------------------------
+Fri May 7 09:29:33 UTC 2021 - psim...@suse.com
+
+- Update persistent-sqlite to version 2.13.0.0.
+ ## 2.13.0.0
+
+ * [#1225](https://github.com/yesodweb/persistent/pull/1225)
+ * Support `persistent-2.13` changes for SqlBackend being made internal.
+
+-------------------------------------------------------------------
Old:
----
persistent-sqlite-2.12.0.0.tar.gz
New:
----
persistent-sqlite-2.13.0.0.tar.gz
persistent-sqlite.cabal
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-sqlite.spec ++++++
--- /var/tmp/diff_new_pack.sUQNhG/_old 2021-05-11 23:04:17.252922878 +0200
+++ /var/tmp/diff_new_pack.sUQNhG/_new 2021-05-11 23:04:17.256922860 +0200
@@ -19,12 +19,13 @@
%global pkg_name persistent-sqlite
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.12.0.0
+Version: 2.13.0.0
Release: 0
Summary: Backend for the persistent library using sqlite3
License: MIT
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
+Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-bytestring-devel
@@ -77,6 +78,7 @@
%prep
%autosetup -n %{pkg_name}-%{version}
+cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%define cabal_configure_options -fsystemlib
++++++ persistent-sqlite-2.12.0.0.tar.gz -> persistent-sqlite-2.13.0.0.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.12.0.0/ChangeLog.md
new/persistent-sqlite-2.13.0.0/ChangeLog.md
--- old/persistent-sqlite-2.12.0.0/ChangeLog.md 2021-03-29 21:25:27.000000000
+0200
+++ new/persistent-sqlite-2.13.0.0/ChangeLog.md 2021-05-05 23:13:54.000000000
+0200
@@ -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)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-sqlite-2.12.0.0/Database/Persist/Sqlite.hs
new/persistent-sqlite-2.13.0.0/Database/Persist/Sqlite.hs
--- old/persistent-sqlite-2.12.0.0/Database/Persist/Sqlite.hs 2021-03-29
21:25:27.000000000 +0200
+++ new/persistent-sqlite-2.13.0.0/Database/Persist/Sqlite.hs 2021-05-05
23:10:13.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.12.0.0/persistent-sqlite.cabal
new/persistent-sqlite-2.13.0.0/persistent-sqlite.cabal
--- old/persistent-sqlite-2.12.0.0/persistent-sqlite.cabal 2021-03-29
21:25:27.000000000 +0200
+++ new/persistent-sqlite-2.13.0.0/persistent-sqlite.cabal 2021-05-05
23:10:13.000000000 +0200
@@ -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 <mich...@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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-sqlite-2.12.0.0/test/Database/Persist/Sqlite/CompositeSpec.hs
new/persistent-sqlite-2.13.0.0/test/Database/Persist/Sqlite/CompositeSpec.hs
---
old/persistent-sqlite-2.12.0.0/test/Database/Persist/Sqlite/CompositeSpec.hs
1970-01-01 01:00:00.000000000 +0100
+++
new/persistent-sqlite-2.13.0.0/test/Database/Persist/Sqlite/CompositeSpec.hs
2021-05-05 23:10:13.000000000 +0200
@@ -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)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.12.0.0/test/SqliteInit.hs
new/persistent-sqlite-2.13.0.0/test/SqliteInit.hs
--- old/persistent-sqlite-2.12.0.0/test/SqliteInit.hs 2021-02-26
21:44:09.000000000 +0100
+++ new/persistent-sqlite-2.13.0.0/test/SqliteInit.hs 2021-05-05
23:10:13.000000000 +0200
@@ -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
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.12.0.0/test/main.hs
new/persistent-sqlite-2.13.0.0/test/main.hs
--- old/persistent-sqlite-2.12.0.0/test/main.hs 2021-03-29 21:25:27.000000000
+0200
+++ new/persistent-sqlite-2.13.0.0/test/main.hs 2021-05-05 23:10:13.000000000
+0200
@@ -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
-
- 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
-
- runSqliteInfo connInfo $ do
- void $ runMigrationSilent compositeMigrateTest
- validateForeignKeys
-
- 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 ()
-
-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)
+ 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
+ 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
+
+ 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 "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 ()
++++++ persistent-sqlite.cabal ++++++
name: persistent-sqlite
version: 2.13.0.0
x-revision: 1
license: MIT
license-file: LICENSE
author: Michael Snoyman <mich...@snoyman.com>
maintainer: Michael Snoyman <mich...@snoyman.com>
synopsis: Backend for the persistent library using sqlite3.
description: This package includes a thin sqlite3 wrapper based on the
direct-sqlite package, as well as the entire C library, so there are no system
dependencies.
category: Database, Yesod
stability: Stable
cabal-version: >= 1.10
build-type: Simple
homepage: http://www.yesodweb.com/book/persistent
bug-reports: https://github.com/yesodweb/persistent/issues
extra-source-files: ChangeLog.md cbits/*.c cbits/*.h
flag systemlib
description: Use the system-wide sqlite library
default: False
flag use-pkgconfig
description: Use pkg-config to find system sqlite library
default: False
flag build-sanity-exe
description: Build a sanity check test executable
default: False
flag full-text-search
description: Enable full-text search in the vendored SQLite library; has no
effect if a system SQLite library is used.
default: True
flag uri-filenames
description: Enable URI filenames in the vendored SQLite library; has no
effect if a system SQLite library is used.
default: True
flag have-usleep
description: Enable usleep in the vendored SQLite library; has no effect if a
system SQLite library is used.
default: True
flag json1
description: Enable json1 in the vendored SQLite library; has no effect if a
system SQLite library is used.
default: True
flag use-stat3
description: This flag is now a no-op, as the corresponding SQLite option is
now a no-op; has no effect if a system SQLite library is used.
default: False
flag use-stat4
description: Enable STAT4 in the vendored SQLite library (supercedes stat3);
has no effect if a system SQLite library is used.
default: True
library
build-depends: base >= 4.9 && < 4.15
, persistent >= 2.13 && < 3
, aeson >= 1.0
, bytestring >= 0.10
, conduit >= 1.2.12
, containers >= 0.5
, microlens-th >= 0.4.1.1
, monad-logger >= 0.3.25
, mtl
, resource-pool
, resourcet >= 1.1.9
, text >= 1.2
, time
, transformers >= 0.5
, unliftio-core
, unordered-containers
exposed-modules: Database.Sqlite
Database.Sqlite.Internal
Database.Persist.Sqlite
ghc-options: -Wall
default-language: Haskell2010
if flag(systemlib)
if flag(use-pkgconfig)
pkgconfig-depends: sqlite3
else
extra-libraries: sqlite3
else
c-sources: cbits/sqlite3.c
include-dirs: cbits
includes: sqlite3.h
install-includes: sqlite3.h
cc-options: -fPIC -std=c99
if flag(full-text-search)
cc-options: -DSQLITE_ENABLE_FTS3
-DSQLITE_ENABLE_FTS3_PARENTHESIS
-DSQLITE_ENABLE_FTS4
-DSQLITE_ENABLE_FTS5
if flag(uri-filenames)
cc-options: -DSQLITE_USE_URI
if flag(have-usleep)
cc-options: -DHAVE_USLEEP
if flag(json1)
cc-options: -DSQLITE_ENABLE_JSON1
if flag(use-stat4)
cc-options: -DSQLITE_ENABLE_STAT4
c-sources: cbits/config.c
if !os(windows)
extra-libraries: pthread
source-repository head
type: git
location: git://github.com/yesodweb/persistent.git
executable sanity
if flag(build-sanity-exe)
buildable: True
else
buildable: False
main-is: sanity.hs
hs-source-dirs: test
build-depends: base
, persistent-sqlite
, monad-logger
default-language: Haskell2010
test-suite test
type: exitcode-stdio-1.0
main-is: main.hs
hs-source-dirs: test
other-modules:
SqliteInit
Database.Persist.Sqlite.CompositeSpec
ghc-options: -Wall
build-depends: base >= 4.9 && < 5
, persistent
, persistent-sqlite
, persistent-test
, bytestring
, containers
, conduit
, exceptions
, fast-logger
, hspec >= 2.4
, HUnit
, microlens
, monad-logger
, mtl
, QuickCheck
, resourcet
, system-fileio
, system-filepath
, temporary
, text
, time
, transformers
, time
, unliftio-core
default-language: Haskell2010
