Hello community,
here is the log from the commit of package ghc-persistent-sqlite for
openSUSE:Leap:15.2 checked in at 2020-02-19 18:40:34
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Leap:15.2/ghc-persistent-sqlite (Old)
and /work/SRC/openSUSE:Leap:15.2/.ghc-persistent-sqlite.new.26092 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-sqlite"
Wed Feb 19 18:40:34 2020 rev:13 rq:771412 version:2.10.5.2
Changes:
--------
---
/work/SRC/openSUSE:Leap:15.2/ghc-persistent-sqlite/ghc-persistent-sqlite.changes
2020-01-15 15:02:27.777811285 +0100
+++
/work/SRC/openSUSE:Leap:15.2/.ghc-persistent-sqlite.new.26092/ghc-persistent-sqlite.changes
2020-02-19 18:40:35.286144422 +0100
@@ -1,0 +2,75 @@
+Sat Jan 4 03:01:37 UTC 2020 - [email protected]
+
+- Update persistent-sqlite to version 2.10.5.2.
+ ## 2.10.5.2
+
+ * Compatibility with latest persistent-template for test suite
[#1002](https://github.com/yesodweb/persistent/pull/1002/files)
+
+ ## 2.10.5.1
+
+ * a fix for template-haskell 2.16, GHC 8.10 alpha
[#993](https://github.com/yesodweb/persistent/pull/993) @simonmichael
+
+-------------------------------------------------------------------
+Fri Nov 8 16:14:27 UTC 2019 - Peter Simons <[email protected]>
+
+- Drop obsolete group attributes.
+
+-------------------------------------------------------------------
+Wed Aug 21 02:02:45 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.10.5.
+ ## 2.10.5
+
+ * Foreign keys table constraints are correctly generated
[#945](https://github.com/yesodweb/persistent/pull/945) @kderme
+
+-------------------------------------------------------------------
+Thu Jul 25 02:02:25 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.10.4.
+ ## 2.10.4
+
+ * Fix bug with 2.10.3 and 2.10.2 that caused the `RawSqlite` loop.
[#934](https://github.com/yesodweb/persistent/pull/934) @merijn
+
+-------------------------------------------------------------------
+Thu Jul 18 08:17:36 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.10.3.
+ ## 2.10.3
+
+ * Unique constraints are correctly generated.
[#922](https://github.com/yesodweb/persistent/pull/922) @kderme
+
+ ## 2.10.2
+
+ * Add a new `RawSqlite` type and `withRawSqliteConnInfo` function that allow
access to the underlying Sqlite `Connection` type.
[#772](https://github.com/yesodweb/persistent/pull/772)
+ * Expose the internals of `Connection` in an Internal module, allowing the
user to call SQLite functions via the C FFI.
[#772](https://github.com/yesodweb/persistent/pull/772)
+ * Add a flag for SQLITE_STAT4 and enable it by default, allowing for better
query optimisation when using ANALYZE. This breaks the query planner stability
guarantee, but the required flag for that isn't enabled or exposed by
persistent. Only affects the vendored SQLite library, has no effect when using
system SQLite.
+ * Add support for migrating entities with composite primary keys. Fixes
[#669](https://github.com/yesodweb/persistent/issues/669)
+ * Fix a bug when using the `Filter` datatype directly. See
[#915](https://github.com/yesodweb/persistent/pull/915) for more details.
+
+-------------------------------------------------------------------
+Tue Jul 2 02:02:08 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.10.1.
+ ## 2.10.1
+
+ * Add support for reading text values with null characters from the
database. Fixes [#921](https://github.com/yesodweb/persistent/issues/921)
+
+-------------------------------------------------------------------
+Sat Apr 20 09:17:16 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.10.0.
+ ## 2.10.0
+
+ * Updated for `persistent-2.10.0` compatibility.
+
+-------------------------------------------------------------------
+Mon Apr 8 02:02:01 UTC 2019 - [email protected]
+
+- Update persistent-sqlite to version 2.9.3.
+ ## 2.9.3
+
+ * Add retry-on-busy support, automatically retrying when sqlite returns a
busy
+ error on enabling WAL mode, and providing helper `retryOnBusy` and
+ `waitForDatabase` identifiers.
+
+-------------------------------------------------------------------
Old:
----
persistent-sqlite-2.9.2.tar.gz
New:
----
persistent-sqlite-2.10.5.2.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-sqlite.spec ++++++
--- /var/tmp/diff_new_pack.BpPA1a/_old 2020-02-19 18:40:36.058145370 +0100
+++ /var/tmp/diff_new_pack.BpPA1a/_new 2020-02-19 18:40:36.062145375 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-persistent-sqlite
#
-# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,11 +19,10 @@
%global pkg_name persistent-sqlite
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.9.2
+Version: 2.10.5.2
Release: 0
Summary: Backend for the persistent library using sqlite3
License: MIT
-Group: Development/Libraries/Haskell
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
@@ -33,7 +32,6 @@
BuildRequires: ghc-containers-devel
BuildRequires: ghc-microlens-th-devel
BuildRequires: ghc-monad-logger-devel
-BuildRequires: ghc-old-locale-devel
BuildRequires: ghc-persistent-devel
BuildRequires: ghc-resource-pool-devel
BuildRequires: ghc-resourcet-devel
@@ -46,8 +44,15 @@
BuildRequires: glibc-devel
BuildRequires: sqlite3-devel
%if %{with tests}
+BuildRequires: ghc-HUnit-devel
+BuildRequires: ghc-QuickCheck-devel
+BuildRequires: ghc-exceptions-devel
+BuildRequires: ghc-fast-logger-devel
BuildRequires: ghc-hspec-devel
BuildRequires: ghc-persistent-template-devel
+BuildRequires: ghc-persistent-test-devel
+BuildRequires: ghc-system-fileio-devel
+BuildRequires: ghc-system-filepath-devel
BuildRequires: ghc-temporary-devel
%endif
@@ -57,7 +62,6 @@
%package devel
Summary: Haskell %{pkg_name} library development files
-Group: Development/Libraries/Haskell
Requires: %{name} = %{version}-%{release}
Requires: ghc-compiler = %{ghc_version}
Requires: glibc-devel
@@ -71,9 +75,9 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cabal-tweak-flag systemlib True
%build
+%define cabal_configure_options -fsystemlib
%ghc_lib_build
%install
++++++ persistent-sqlite-2.9.2.tar.gz -> persistent-sqlite-2.10.5.2.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/ChangeLog.md
new/persistent-sqlite-2.10.5.2/ChangeLog.md
--- old/persistent-sqlite-2.9.2/ChangeLog.md 2018-12-30 05:47:05.000000000
+0100
+++ new/persistent-sqlite-2.10.5.2/ChangeLog.md 2020-01-03 20:00:03.000000000
+0100
@@ -1,5 +1,47 @@
# Changelog for persistent-sqlite
+## 2.10.5.2
+
+* Compatibility with latest persistent-template for test suite
[#1002](https://github.com/yesodweb/persistent/pull/1002/files)
+
+## 2.10.5.1
+
+* a fix for template-haskell 2.16, GHC 8.10 alpha
[#993](https://github.com/yesodweb/persistent/pull/993) @simonmichael
+
+## 2.10.5
+
+* Foreign keys table constraints are correctly generated
[#945](https://github.com/yesodweb/persistent/pull/945) @kderme
+
+## 2.10.4
+
+* Fix bug with 2.10.3 and 2.10.2 that caused the `RawSqlite` loop.
[#934](https://github.com/yesodweb/persistent/pull/934) @merijn
+
+## 2.10.3
+
+* Unique constraints are correctly generated.
[#922](https://github.com/yesodweb/persistent/pull/922) @kderme
+
+## 2.10.2
+
+* Add a new `RawSqlite` type and `withRawSqliteConnInfo` function that allow
access to the underlying Sqlite `Connection` type.
[#772](https://github.com/yesodweb/persistent/pull/772)
+* Expose the internals of `Connection` in an Internal module, allowing the
user to call SQLite functions via the C FFI.
[#772](https://github.com/yesodweb/persistent/pull/772)
+* Add a flag for SQLITE_STAT4 and enable it by default, allowing for better
query optimisation when using ANALYZE. This breaks the query planner stability
guarantee, but the required flag for that isn't enabled or exposed by
persistent. Only affects the vendored SQLite library, has no effect when using
system SQLite.
+* Add support for migrating entities with composite primary keys. Fixes
[#669](https://github.com/yesodweb/persistent/issues/669)
+* Fix a bug when using the `Filter` datatype directly. See
[#915](https://github.com/yesodweb/persistent/pull/915) for more details.
+
+## 2.10.1
+
+* Add support for reading text values with null characters from the database.
Fixes [#921](https://github.com/yesodweb/persistent/issues/921)
+
+## 2.10.0
+
+* Updated for `persistent-2.10.0` compatibility.
+
+## 2.9.3
+
+* Add retry-on-busy support, automatically retrying when sqlite returns a busy
+ error on enabling WAL mode, and providing helper `retryOnBusy` and
+ `waitForDatabase` identifiers.
+
## 2.9.2
* Add enableExtendedResultCodes and disableExtendedResultCodes functions
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Persist/Sqlite.hs
new/persistent-sqlite-2.10.5.2/Database/Persist/Sqlite.hs
--- old/persistent-sqlite-2.9.2/Database/Persist/Sqlite.hs 2018-12-30
02:20:10.000000000 +0100
+++ new/persistent-sqlite-2.10.5.2/Database/Persist/Sqlite.hs 2020-01-03
05:03:17.000000000 +0100
@@ -1,11 +1,14 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
-- | A sqlite backend for persistent.
--
-- Note: If you prepend @WAL=off @ to your connection string, it will disable
@@ -30,21 +33,20 @@
, wrapConnection
, wrapConnectionInfo
, mockMigration
+ , retryOnBusy
+ , waitForDatabase
+ , RawSqlite
+ , persistentBackend
+ , rawSqliteConnection
+ , withRawSqliteConnInfo
) where
-import Database.Persist.Sql
-import Database.Persist.Sql.Types.Internal (mkPersistBackend)
-import qualified Database.Persist.Sql.Util as Util
-
-import qualified Database.Sqlite as Sqlite
-
-import Control.Applicative as A
+import Control.Concurrent (threadDelay)
import qualified Control.Exception as E
import Control.Monad (forM_)
-import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withUnliftIO,
unliftIO)
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger)
-import Control.Monad.Trans.Reader (ReaderT, runReaderT)
-import UnliftIO.Resource (ResourceT, runResourceT)
+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO,
withUnliftIO, unliftIO, withRunInIO)
+import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger, logWarn,
runLoggingT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Aeson
@@ -61,14 +63,20 @@
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Lens.Micro.TH (makeLenses)
+import UnliftIO.Resource (ResourceT, runResourceT)
+
+import Database.Persist.Sql
+import qualified Database.Persist.Sql.Util as Util
+import qualified Database.Sqlite as Sqlite
+
-- | Create a pool of SQLite connections.
--
-- Note that this should not be used with the @:memory:@ connection string, as
-- the pool will regularly remove connections, destroying your database.
-- Instead, use 'withSqliteConn'.
-createSqlitePool :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend backend)
- => Text -> Int -> m (Pool backend)
+createSqlitePool :: (MonadLogger m, MonadUnliftIO m)
+ => Text -> Int -> m (Pool SqlBackend)
createSqlitePool = createSqlitePoolFromInfo . conStringToInfo
-- | Create a pool of SQLite connections.
@@ -78,43 +86,47 @@
-- Instead, use 'withSqliteConn'.
--
-- @since 2.6.2
-createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend
backend)
- => SqliteConnectionInfo -> Int -> m (Pool backend)
-createSqlitePoolFromInfo connInfo = createSqlPool $ open' connInfo
+createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)
+ => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
+createSqlitePoolFromInfo connInfo = createSqlPool $ openWith const connInfo
-- | Run the given action with a connection pool.
--
-- Like 'createSqlitePool', this should not be used with @:memory:@.
-withSqlitePool :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
+withSqlitePool :: (MonadUnliftIO m, MonadLogger m)
=> Text
-> Int -- ^ number of connections to open
- -> (Pool backend -> m a) -> m a
-withSqlitePool connInfo = withSqlPool . open' $ conStringToInfo connInfo
+ -> (Pool SqlBackend -> m a) -> m a
+withSqlitePool connInfo = withSqlPool . openWith const $ conStringToInfo
connInfo
-- | Run the given action with a connection pool.
--
-- Like 'createSqlitePool', this should not be used with @:memory:@.
--
-- @since 2.6.2
-withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => SqliteConnectionInfo
- -> Int -- ^ number of connections to open
- -> (Pool backend -> m a) -> m a
-withSqlitePoolInfo connInfo = withSqlPool $ open' connInfo
+withSqlitePoolInfo :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo
+ -> Int -- ^ number of connections to open
+ -> (Pool SqlBackend -> m a) -> m a
+withSqlitePoolInfo connInfo = withSqlPool $ openWith const connInfo
-withSqliteConn :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => Text -> (backend -> m a) -> m a
+withSqliteConn :: (MonadUnliftIO m, MonadLogger m)
+ => Text -> (SqlBackend -> m a) -> m a
withSqliteConn = withSqliteConnInfo . conStringToInfo
-- | @since 2.6.2
-withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend)
- => SqliteConnectionInfo -> (backend -> m a) -> m a
-withSqliteConnInfo = withSqlConn . open'
-
-open' :: (IsSqlBackend backend) => SqliteConnectionInfo -> LogFunc -> IO
backend
-open' connInfo logFunc = do
+withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
+withSqliteConnInfo = withSqlConn . openWith const
+
+openWith :: (SqlBackend -> Sqlite.Connection -> r)
+ -> SqliteConnectionInfo
+ -> LogFunc
+ -> IO r
+openWith f connInfo logFunc = do
conn <- Sqlite.open $ _sqlConnectionStr connInfo
- wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn
+ backend <- wrapConnectionInfo connInfo conn logFunc `E.onException`
Sqlite.close conn
+ return $ f backend conn
-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL 'Connection'.
--
@@ -128,20 +140,20 @@
-- > {-# LANGUAGE TemplateHaskell #-}
-- > {-# LANGUAGE QuasiQuotes #-}
-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}
--- >
+-- >
-- > import Control.Monad.IO.Class (liftIO)
-- > import Database.Persist
-- > import Database.Sqlite
-- > import Database.Persist.Sqlite
-- > import Database.Persist.TH
--- >
+-- >
-- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-- > Person
-- > name String
-- > age Int Maybe
-- > deriving Show
-- > |]
--- >
+-- >
-- > main :: IO ()
-- > main = do
-- > conn <- open "/home/sibi/test.db"
@@ -158,46 +170,80 @@
--
-- > Migrating: CREATE TABLE "person"("id" INTEGER PRIMARY KEY,"name" VARCHAR
NOT NULL,"age" INTEGER NULL)
-- > [Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey
{unSqlBackendKey = 1}}, entityVal = Person {personName = "John doe", personAge
= Just 35}},Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey
{unSqlBackendKey = 2}}, entityVal = Person {personName = "Hema", personAge =
Just 36}}]
---
+--
-- @since 1.1.5
-wrapConnection :: (IsSqlBackend backend) => Sqlite.Connection -> LogFunc -> IO
backend
+wrapConnection :: Sqlite.Connection -> LogFunc -> IO SqlBackend
wrapConnection = wrapConnectionInfo (mkSqliteConnectionInfo "")
+-- | Retry if a Busy is thrown, following an exponential backoff strategy.
+--
+-- @since 2.9.3
+retryOnBusy :: (MonadUnliftIO m, MonadLogger m) => m a -> m a
+retryOnBusy action =
+ start $ take 20 $ delays 1000
+ where
+ delays x
+ | x >= 1000000 = repeat x
+ | otherwise = x : delays (x * 2)
+
+ start [] = do
+ $logWarn "Out of retry attempts"
+ action
+ start (x:xs) = do
+ -- Using try instead of catch to avoid creating a stack overflow
+ eres <- withRunInIO $ \run -> E.try $ run action
+ case eres of
+ Left (Sqlite.SqliteException { Sqlite.seError = Sqlite.ErrorBusy }) ->
do
+ $logWarn "Encountered an SQLITE_BUSY, going to retry..."
+ liftIO $ threadDelay x
+ start xs
+ Left e -> liftIO $ E.throwIO e
+ Right y -> return y
+
+-- | Wait until some noop action on the database does not return an
'Sqlite.ErrorBusy'. See 'retryOnBusy'.
+--
+-- @since 2.9.3
+waitForDatabase
+ :: (MonadUnliftIO m, MonadLogger m, BackendCompatible SqlBackend backend)
+ => ReaderT backend m ()
+waitForDatabase = retryOnBusy $ rawExecute "SELECT 42" []
+
-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL
-- 'Connection', allowing full control over WAL and FK constraints.
--
-- @since 2.6.2
-wrapConnectionInfo :: (IsSqlBackend backend)
- => SqliteConnectionInfo
- -> Sqlite.Connection
- -> LogFunc
- -> IO backend
+wrapConnectionInfo
+ :: SqliteConnectionInfo
+ -> Sqlite.Connection
+ -> LogFunc
+ -> IO SqlBackend
wrapConnectionInfo connInfo conn logFunc = do
let
-- Turn on the write-ahead log
-- https://github.com/yesodweb/persistent/issues/363
walPragma
- | _walEnabled connInfo = ("PRAGMA journal_mode=WAL;":)
+ | _walEnabled connInfo = (("PRAGMA journal_mode=WAL;", True):)
| otherwise = id
-- Turn on foreign key constraints
-- https://github.com/yesodweb/persistent/issues/646
fkPragma
- | _fkEnabled connInfo = ("PRAGMA foreign_keys = on;":)
+ | _fkEnabled connInfo = (("PRAGMA foreign_keys = on;", False):)
| otherwise = id
-- Allow arbitrary additional pragmas to be set
-- https://github.com/commercialhaskell/stack/issues/4247
- pragmas = walPragma $ fkPragma $ _extraPragmas connInfo
+ pragmas = walPragma $ fkPragma $ map (, False) $ _extraPragmas connInfo
- forM_ pragmas $ \pragma -> do
+ forM_ pragmas $ \(pragma, shouldRetry) -> flip runLoggingT logFunc $
+ (if shouldRetry then retryOnBusy else id) $ liftIO $ do
stmt <- Sqlite.prepare conn pragma
_ <- Sqlite.stepConn conn stmt
Sqlite.reset conn stmt
Sqlite.finalize stmt
smap <- newIORef $ Map.empty
- return . mkPersistBackend $ SqlBackend
+ return $ SqlBackend
{ connPrepare = prepare' conn
, connStmtMap = smap
, connInsertSql = insertSql'
@@ -229,9 +275,9 @@
-- that all log messages are discarded.
--
-- @since 1.1.4
-runSqlite :: (MonadUnliftIO m, IsSqlBackend backend)
+runSqlite :: (MonadUnliftIO m)
=> Text -- ^ connection string
- -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database action
+ -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database
action
-> m a
runSqlite connstr = runResourceT
. runNoLoggingT
@@ -243,9 +289,9 @@
-- that all log messages are discarded.
--
-- @since 2.6.2
-runSqliteInfo :: (MonadUnliftIO m, IsSqlBackend backend)
+runSqliteInfo :: (MonadUnliftIO m)
=> SqliteConnectionInfo
- -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database
action
+ -> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -- ^ database
action
-> m a
runSqliteInfo conInfo = runResourceT
. runNoLoggingT
@@ -345,8 +391,8 @@
-> EntityDef
-> IO (Either [Text] [(Bool, Text)])
migrate' allDefs getter val = do
- let (cols, uniqs, _) = mkColumns allDefs val
- let newSql = mkCreateTable False def (filter (not . safeToRemove val .
cName) cols, uniqs)
+ let (cols, uniqs, fdefs) = mkColumns allDefs val
+ let newSql = mkCreateTable False def (filter (not . safeToRemove val .
cName) cols, uniqs, fdefs)
stmt <- getter "SELECT sql FROM sqlite_master WHERE type='table' AND
name=?"
oldSql' <- with (stmtQuery stmt [PersistText $ unDBName table])
(\src -> runConduit $ src .| go)
@@ -428,15 +474,18 @@
let oldCols = map DBName $ filter (/= "id") oldCols' -- need to update for
table id attribute ?
let newCols = filter (not . safeToRemove def) $ map cName cols
let common = filter (`elem` oldCols) newCols
- let id_ = fieldDB (entityId def)
return [ (False, tmpSql)
- , (False, copyToTemp $ id_ : common)
+ , (False, copyToTemp $ addIdCol common)
, (common /= filter (not . safeToRemove def) oldCols, dropOld)
, (False, newSql)
- , (False, copyToFinal $ id_ : newCols)
+ , (False, copyToFinal $ addIdCol newCols)
, (False, dropTmp)
]
where
+ addIdCol = case entityPrimary def of
+ Nothing -> (fieldDB (entityId def) :)
+ Just _ -> id
+
getCols = do
x <- CL.head
case x of
@@ -447,10 +496,10 @@
Just y -> error $ "Invalid result from PRAGMA table_info: " ++
show y
table = entityDB def
tableTmp = DBName $ unDBName table <> "_backup"
- (cols, uniqs, _) = mkColumns allDefs def
+ (cols, uniqs, fdef) = mkColumns allDefs def
cols' = filter (not . safeToRemove def . cName) cols
- newSql = mkCreateTable False def (cols', uniqs)
- tmpSql = mkCreateTable True def { entityDB = tableTmp } (cols', uniqs)
+ newSql = mkCreateTable False def (cols', uniqs, fdef)
+ tmpSql = mkCreateTable True def { entityDB = tableTmp } (cols', uniqs, [])
dropTmp = "DROP TABLE " <> escape tableTmp
dropOld = "DROP TABLE " <> escape table
copyToTemp common = T.concat
@@ -472,8 +521,8 @@
, escape tableTmp
]
-mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef]) -> Text
-mkCreateTable isTemp entity (cols, uniqs) =
+mkCreateTable :: Bool -> EntityDef -> ([Column], [UniqueDef], [ForeignDef]) ->
Text
+mkCreateTable isTemp entity (cols, uniqs, fdefs) =
case entityPrimary entity of
Just pdef ->
T.concat
@@ -487,6 +536,8 @@
, "("
, T.intercalate "," $ map (escape . fieldDB) $ compositeFields pdef
, ")"
+ , T.concat $ map sqlUnique uniqs
+ , T.concat $ map sqlForeign fdefs
, ")"
]
Nothing -> T.concat
@@ -502,6 +553,7 @@
, mayDefault $ defaultAttribute $ fieldAttrs $ entityId entity
, T.concat $ map (sqlColumn isTemp) cols
, T.concat $ map sqlUnique uniqs
+ , T.concat $ map sqlForeign fdefs
, ")"
]
@@ -523,6 +575,19 @@
Just (table, _) -> if noRef then "" else " REFERENCES " <> escape table
]
+sqlForeign :: ForeignDef -> Text
+sqlForeign fdef = T.concat
+ [ ", CONSTRAINT "
+ , escape $ foreignConstraintNameDBName fdef
+ , " FOREIGN KEY("
+ , T.intercalate "," $ map (escape . snd. fst) $ foreignFields fdef
+ , ") REFERENCES "
+ , escape $ foreignRefTableDBName fdef
+ , "("
+ , T.intercalate "," $ map (escape . snd . snd) $ foreignFields fdef
+ , ")"
+ ]
+
sqlUnique :: UniqueDef -> Text
sqlUnique (UniqueDef _ cname cols _) = T.concat
[ ",CONSTRAINT "
@@ -590,11 +655,11 @@
parseJSON v = modifyFailure ("Persistent: error loading Sqlite conf: " ++)
$ flip (withObject "SqliteConf") v parser where
parser o = if HashMap.member "database" o
then SqliteConf
- A.<$> o .: "database"
- A.<*> o .: "poolsize"
+ <$> o .: "database"
+ <*> o .: "poolsize"
else SqliteConfInfo
- A.<$> o .: "connInfo"
- A.<*> o .: "poolsize"
+ <$> o .: "connInfo"
+ <*> o .: "poolsize"
instance PersistConfig SqliteConf where
type PersistConfigBackend SqliteConf = SqlPersistT
@@ -639,7 +704,6 @@
, _fkEnabled :: Bool -- ^ if foreign-key constraints are enabled.
, _extraPragmas :: [Text] -- ^ additional pragmas to be set on
initialization
} deriving Show
-makeLenses ''SqliteConnectionInfo
instance FromJSON SqliteConnectionInfo where
parseJSON v = modifyFailure ("Persistent: error loading
SqliteConnectionInfo: " ++) $
@@ -648,3 +712,94 @@
<*> o .: "walEnabled"
<*> o .: "fkEnabled"
<*> o .:? "extraPragmas" .!= []
+
+makeLenses ''SqliteConnectionInfo
+
+-- | Like `withSqliteConnInfo`, but exposes the internal `Sqlite.Connection`.
+-- For power users who want to manually interact with SQLite's C API via
+-- internals exposed by "Database.Sqlite.Internal"
+--
+-- @since 2.10.2
+withRawSqliteConnInfo
+ :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo
+ -> (RawSqlite SqlBackend -> m a)
+ -> m a
+withRawSqliteConnInfo connInfo f = do
+ logFunc <- askLogFunc
+ withRunInIO $ \run -> E.bracket (openBackend logFunc) closeBackend $ run .
f
+ where
+ openBackend = openWith RawSqlite connInfo
+ closeBackend = close' . _persistentBackend
+
+-- | Wrapper for persistent SqlBackends that carry the corresponding
+-- `Sqlite.Connection`.
+--
+-- @since 2.10.2
+data RawSqlite backend = RawSqlite
+ { _persistentBackend :: backend -- ^ The persistent backend
+ , _rawSqliteConnection :: Sqlite.Connection -- ^ The underlying
`Sqlite.Connection`
+ }
+makeLenses ''RawSqlite
+
+instance HasPersistBackend b => HasPersistBackend (RawSqlite b) where
+ type BaseBackend (RawSqlite b) = BaseBackend b
+ persistBackend = persistBackend . _persistentBackend
+
+instance BackendCompatible b (RawSqlite b) where
+ projectBackend = _persistentBackend
+
+instance (PersistCore b) => PersistCore (RawSqlite b) where
+ newtype BackendKey (RawSqlite b) = RawSqliteKey (BackendKey b)
+
+deriving instance (Show (BackendKey b)) => Show (BackendKey (RawSqlite b))
+deriving instance (Read (BackendKey b)) => Read (BackendKey (RawSqlite b))
+deriving instance (Eq (BackendKey b)) => Eq (BackendKey (RawSqlite b))
+deriving instance (Ord (BackendKey b)) => Ord (BackendKey (RawSqlite b))
+deriving instance (Num (BackendKey b)) => Num (BackendKey (RawSqlite b))
+deriving instance (Integral (BackendKey b)) => Integral (BackendKey (RawSqlite
b))
+deriving instance (PersistField (BackendKey b)) => PersistField (BackendKey
(RawSqlite b))
+deriving instance (PersistFieldSql (BackendKey b)) => PersistFieldSql
(BackendKey (RawSqlite b))
+deriving instance (Real (BackendKey b)) => Real (BackendKey (RawSqlite b))
+deriving instance (Enum (BackendKey b)) => Enum (BackendKey (RawSqlite b))
+deriving instance (Bounded (BackendKey b)) => Bounded (BackendKey (RawSqlite
b))
+deriving instance (ToJSON (BackendKey b)) => ToJSON (BackendKey (RawSqlite b))
+deriving instance (FromJSON (BackendKey b)) => FromJSON (BackendKey (RawSqlite
b))
+
+instance (PersistStoreRead b) => PersistStoreRead (RawSqlite b) where
+ get = withReaderT _persistentBackend . get
+ getMany = withReaderT _persistentBackend . getMany
+
+instance (PersistQueryRead b) => PersistQueryRead (RawSqlite b) where
+ selectSourceRes filts opts = withReaderT _persistentBackend $
selectSourceRes filts opts
+ selectFirst filts opts = withReaderT _persistentBackend $ selectFirst
filts opts
+ selectKeysRes filts opts = withReaderT _persistentBackend $ selectKeysRes
filts opts
+ count = withReaderT _persistentBackend . count
+
+instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where
+ updateWhere filts updates = withReaderT _persistentBackend $ updateWhere
filts updates
+ deleteWhere = withReaderT _persistentBackend . deleteWhere
+
+instance (PersistUniqueRead b) => PersistUniqueRead (RawSqlite b) where
+ getBy = withReaderT _persistentBackend . getBy
+
+instance (PersistStoreWrite b) => PersistStoreWrite (RawSqlite b) where
+ insert = withReaderT _persistentBackend . insert
+ insert_ = withReaderT _persistentBackend . insert_
+ insertMany = withReaderT _persistentBackend . insertMany
+ insertMany_ = withReaderT _persistentBackend . insertMany_
+ insertEntityMany = withReaderT _persistentBackend . insertEntityMany
+ insertKey k = withReaderT _persistentBackend . insertKey k
+ repsert k = withReaderT _persistentBackend . repsert k
+ repsertMany = withReaderT _persistentBackend . repsertMany
+ replace k = withReaderT _persistentBackend . replace k
+ delete = withReaderT _persistentBackend . delete
+ update k = withReaderT _persistentBackend . update k
+ updateGet k = withReaderT _persistentBackend . updateGet k
+
+instance (PersistUniqueWrite b) => PersistUniqueWrite (RawSqlite b) where
+ deleteBy = withReaderT _persistentBackend . deleteBy
+ insertUnique = withReaderT _persistentBackend . insertUnique
+ upsert rec = withReaderT _persistentBackend . upsert rec
+ upsertBy uniq rec = withReaderT _persistentBackend . upsertBy uniq rec
+ putMany = withReaderT _persistentBackend . putMany
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Sqlite/Internal.hs
new/persistent-sqlite-2.10.5.2/Database/Sqlite/Internal.hs
--- old/persistent-sqlite-2.9.2/Database/Sqlite/Internal.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/persistent-sqlite-2.10.5.2/Database/Sqlite/Internal.hs 2019-07-17
02:08:08.000000000 +0200
@@ -0,0 +1,27 @@
+-- | Utterly unsafe internals of the "Database.Sqlite" module. Useful for
+-- people who want access to the SQLite database pointer to manually call
+-- SQLite API functions via the FFI.
+--
+-- Types and functions in this module are *NOT* covered by the PVP and may
+-- change breakingly in any future version of the package.
+module Database.Sqlite.Internal where
+
+import Data.IORef (IORef)
+import Foreign.Ptr (Ptr)
+
+-- | SQLite connection type, consist of an IORef tracking whether the
+-- connection has been closed and the raw SQLite C API pointer, wrapped in a
+-- 'Connection\'' newtype.
+--
+-- @since 2.10.2
+data Connection = Connection !(IORef Bool) Connection'
+
+-- | Newtype wrapping SQLite C API pointer for a database connection.
+--
+-- @since 2.10.2
+newtype Connection' = Connection' (Ptr ())
+
+-- | Newtype wrapping SQLite C API pointer for a prepared statement.
+--
+-- @since 2.10.2
+newtype Statement = Statement (Ptr ())
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Sqlite.hs
new/persistent-sqlite-2.10.5.2/Database/Sqlite.hs
--- old/persistent-sqlite-2.9.2/Database/Sqlite.hs 2018-12-30
05:47:05.000000000 +0100
+++ new/persistent-sqlite-2.10.5.2/Database/Sqlite.hs 2019-07-17
02:08:08.000000000 +0200
@@ -1,6 +1,6 @@
-{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-- | A port of the direct-sqlite package for dealing directly with
-- 'PersistValue's.
module Database.Sqlite (
@@ -8,8 +8,7 @@
Statement,
Error(..),
SqliteException(..),
- StepResult(Row,
- Done),
+ StepResult(Row, Done),
Config(ConfigLogFn),
LogFunction,
SqliteStatus (..),
@@ -81,33 +80,24 @@
import Prelude hiding (error)
import qualified Prelude as P
-import qualified Prelude
+
+import Control.Exception (Exception, throwIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BSU
import qualified Data.ByteString.Internal as BSI
-import Foreign
-import Foreign.C
-import Control.Exception (Exception, throwIO)
-import Control.Applicative as A ((<$>))
-import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
+import Data.Fixed (Pico)
+import Data.IORef (newIORef, readIORef, writeIORef)
+import Data.Monoid (mappend, mconcat)
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
-import Data.Monoid (mappend, mconcat)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Fixed (Pico)
-import Data.Time (formatTime, UTCTime)
+import Data.Time (defaultTimeLocale, formatTime, UTCTime)
import Data.Typeable (Typeable)
+import Database.Sqlite.Internal (Connection(..), Connection'(..),
Statement(..))
+import Foreign
+import Foreign.C
-#if MIN_VERSION_time(1,5,0)
-import Data.Time (defaultTimeLocale)
-#else
-import System.Locale (defaultTimeLocale)
-#endif
-
-data Connection = Connection !(IORef Bool) Connection'
-newtype Connection' = Connection' (Ptr ())
-newtype Statement = Statement (Ptr ())
+import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
-- | A custom exception type to make it easier to catch exceptions.
--
@@ -198,7 +188,7 @@
decodeError 26 = ErrorNotAConnection
decodeError 100 = ErrorRow
decodeError 101 = ErrorDone
-decodeError i = Prelude.error $ "decodeError " ++ show i
+decodeError i = P.error $ "decodeError " ++ show i
decodeColumnType :: Int -> ColumnType
decodeColumnType 1 = IntegerColumn
@@ -206,7 +196,7 @@
decodeColumnType 3 = TextColumn
decodeColumnType 4 = BlobColumn
decodeColumnType 5 = NullColumn
-decodeColumnType i = Prelude.error $ "decodeColumnType " ++ show i
+decodeColumnType i = P.error $ "decodeColumnType " ++ show i
foreign import ccall "sqlite3_errmsg"
errmsgC :: Ptr () -> IO CString
@@ -236,7 +226,7 @@
openError path' = do
let flag = sqliteFlagReadWrite .|. sqliteFlagCreate .|. sqliteFlagUri
BS.useAsCString (encodeUtf8 path') $ \path -> alloca $ \database -> do
- err <- decodeError A.<$> openC path database flag nullPtr
+ err <- decodeError <$> openC path database flag nullPtr
case err of
ErrorOK -> do database' <- peek database
active <- newIORef True
@@ -480,6 +470,7 @@
PersistList l -> bindText statement parameterIndex $ listToJSON l
PersistMap m -> bindText statement parameterIndex $ mapToJSON m
PersistDbSpecific s -> bindText statement parameterIndex $
decodeUtf8With lenientDecode s
+ PersistArray a -> bindText statement parameterIndex $ listToJSON a
-- copy of PersistList's definition
PersistObjectId _ -> P.error "Refusing to serialize a
PersistObjectId to a SQLite value"
)
$ zip [1..] sqlData
@@ -526,7 +517,8 @@
columnText :: Statement -> Int -> IO Text
columnText (Statement statement) columnIndex = do
text <- columnTextC statement columnIndex
- byteString <- BS.packCString text
+ len <- columnBytesC statement columnIndex
+ byteString <- BS.packCStringLen (text, len)
return $ decodeUtf8With lenientDecode byteString
foreign import ccall "sqlite3_column_count"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/persistent-sqlite.cabal
new/persistent-sqlite-2.10.5.2/persistent-sqlite.cabal
--- old/persistent-sqlite-2.9.2/persistent-sqlite.cabal 2018-12-30
05:47:05.000000000 +0100
+++ new/persistent-sqlite-2.10.5.2/persistent-sqlite.cabal 2020-01-03
19:59:49.000000000 +0100
@@ -1,5 +1,5 @@
name: persistent-sqlite
-version: 2.9.2
+version: 2.10.5.2
license: MIT
license-file: LICENSE
author: Michael Snoyman <[email protected]>
@@ -8,7 +8,7 @@
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.8
+cabal-version: >= 1.10
build-type: Simple
homepage: http://www.yesodweb.com/book/persistent
bug-reports: https://github.com/yesodweb/persistent/issues
@@ -35,27 +35,34 @@
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: Enable STAT3 in the vendored SQLite library; 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.8 && < 5
- , bytestring >= 0.9.1
- , transformers >= 0.2.1
- , persistent >= 2.9 && < 3
- , unliftio-core
- , containers >= 0.2
- , text >= 0.7
- , aeson >= 0.6.2
- , conduit >= 1.2.8
- , monad-logger >= 0.2.4
+ build-depends: base >= 4.9 && < 5
+ , persistent >= 2.10 && < 3
+ , aeson >= 1.0
+ , bytestring >= 0.10
+ , conduit >= 1.2.12
+ , containers >= 0.5
, microlens-th >= 0.4.1.1
- , resourcet >= 1.1
- , time
- , old-locale
+ , monad-logger >= 0.3.25
, 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
@@ -76,6 +83,10 @@
cc-options: -DHAVE_USLEEP
if flag(json1)
cc-options: -DSQLITE_ENABLE_JSON1
+ if flag(use-stat3)
+ cc-options: -DSQLITE_ENABLE_STAT3
+ if flag(use-stat4)
+ cc-options: -DSQLITE_ENABLE_STAT4
c-sources: cbits/config.c
@@ -86,21 +97,6 @@
type: git
location: git://github.com/yesodweb/persistent.git
-
-test-suite test
- type: exitcode-stdio-1.0
- main-is: Spec.hs
- hs-source-dirs: test
- build-depends: base
- , hspec
- , persistent
- , persistent-sqlite
- , persistent-template
- , temporary
- , text
- , time
- , transformers
-
executable sanity
if flag(build-sanity-exe)
buildable: True
@@ -108,4 +104,38 @@
buildable: False
main-is: sanity.hs
hs-source-dirs: test
- build-depends: base, persistent-sqlite, monad-logger
+ 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
+ ghc-options: -Wall
+
+ build-depends: base >= 4.9 && < 5
+ , persistent
+ , persistent-sqlite
+ , persistent-template
+ , persistent-test
+ , bytestring
+ , containers
+ , exceptions
+ , fast-logger
+ , hspec >= 2.4
+ , HUnit
+ , monad-logger
+ , QuickCheck
+ , resourcet
+ , system-fileio
+ , system-filepath
+ , temporary
+ , text
+ , time
+ , transformers
+ , time
+ , unliftio-core
+ default-language: Haskell2010
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/test/Spec.hs
new/persistent-sqlite-2.10.5.2/test/Spec.hs
--- old/persistent-sqlite-2.9.2/test/Spec.hs 2018-07-15 06:56:03.000000000
+0200
+++ new/persistent-sqlite-2.10.5.2/test/Spec.hs 1970-01-01 01:00:00.000000000
+0100
@@ -1,53 +0,0 @@
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-module Main
- ( main
- -- avoid warnings
- , TestId
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.Text as T
-import Data.Time
-import Database.Persist.Sqlite
-import Database.Persist.TH
-import qualified Database.Sqlite as Sqlite
-import System.IO (hClose)
-import System.IO.Temp (withSystemTempFile)
-import Test.Hspec
-
-share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
-Test
- time UTCTime
-|]
-
-asIO :: IO a -> IO a
-asIO = id
-
-main :: IO ()
-main = hspec $ do
- it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:")
$ do
- runMigration migrateAll
- _ <- insert . Test $ read "2014-11-30 05:15:25.123"
- [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
- runMigration 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
- runMigration migrateAll
- insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/test/SqliteInit.hs
new/persistent-sqlite-2.10.5.2/test/SqliteInit.hs
--- old/persistent-sqlite-2.9.2/test/SqliteInit.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/persistent-sqlite-2.10.5.2/test/SqliteInit.hs 2019-05-07
01:24:32.000000000 +0200
@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SqliteInit (
+ (@/=), (@==), (==@)
+ , asIO
+ , assertNotEqual
+ , assertNotEmpty
+ , assertEmpty
+ , isTravis
+ , BackendMonad
+ , runConn
+
+ , MonadIO
+ , persistSettings
+ , MkPersistSettings (..)
+ , db
+ , sqlite_database
+ , sqlite_database_file
+ , BackendKey(..)
+ , GenerateKey(..)
+
+ , RunDb
+ -- re-exports
+ , module Database.Persist
+ , 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
+ , TestFn(..)
+ , truncateTimeOfDay
+ , truncateToMicro
+ , truncateUTCTime
+ , arbText
+ , liftA2
+ , MonadFail
+ ) where
+
+import Init
+ ( TestFn(..), truncateTimeOfDay, truncateUTCTime
+ , truncateToMicro, arbText, liftA2, GenerateKey(..)
+ , (@/=), (@==), (==@), MonadFail
+ , assertNotEqual, assertNotEmpty, assertEmpty, asIO
+ , isTravis, RunDb
+ )
+
+-- re-exports
+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 Test.Hspec
+
+-- testing
+import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)
+
+import Control.Monad (unless, (>=>))
+import Control.Monad.IO.Unlift (MonadUnliftIO)
+import Control.Monad.Logger
+import Control.Monad.Trans.Resource (ResourceT, runResourceT)
+import qualified Data.ByteString as BS
+import Data.Text (Text)
+import System.Log.FastLogger (fromLogStr)
+
+import Database.Persist
+import Database.Persist.Sql
+import Database.Persist.Sqlite
+import Database.Persist.TH ()
+
+
+-- Data types
+import Control.Monad.IO.Class
+import Data.Int (Int32, Int64)
+
+
+_debugOn :: Bool
+_debugOn = False
+
+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 ()
+
+db :: SqlPersistT (LoggingT (ResourceT IO)) () -> Assertion
+db actions = do
+ runResourceT $ runConn $ actions >> transactionUndo
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/test/main.hs
new/persistent-sqlite-2.10.5.2/test/main.hs
--- old/persistent-sqlite-2.9.2/test/main.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/persistent-sqlite-2.10.5.2/test/main.hs 2020-01-03 05:03:17.000000000
+0100
@@ -0,0 +1,242 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+
+import SqliteInit
+
+import qualified CompositeTest
+import qualified CustomPersistFieldTest
+import qualified CustomPrimaryKeyReferenceTest
+import qualified DataTypeTest
+import qualified EmptyEntityTest
+import qualified EmbedOrderTest
+import qualified EmbedTest
+import qualified EquivalentTypeTest
+import qualified HtmlTest
+import qualified LargeNumberTest
+import qualified MaxLenTest
+import qualified MpsNoPrefixTest
+import qualified MigrationColumnLengthTest
+import qualified MigrationOnlyTest
+import qualified PersistentTest
+import qualified PersistUniqueTest
+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
+
+import Control.Exception (handle, IOException)
+import Control.Monad.Catch (catch)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.ByteString as BS
+import Data.Fixed
+import Data.IntMap (IntMap)
+import qualified Data.Text as T
+import Data.Time
+import Filesystem (removeFile)
+import Filesystem.Path.CurrentOS (fromText)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import System.IO (hClose)
+import System.IO.Temp (withSystemTempFile)
+
+import Database.Persist.Sqlite
+import qualified Database.Sqlite as Sqlite
+import PersistentTestModels
+
+import qualified MigrationTest
+
+type Tuple = (,)
+
+-- 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
+|]
+
+share [mkPersist sqlSettings, mkMigrate "compositeSetup"] [persistLowerCase|
+Simple
+ int Int
+ text Text
+ Primary text int
+ deriving Show Eq
+|]
+
+share [mkPersist sqlSettings, mkMigrate "compositeMigrateTest"]
[persistLowerCase|
+Simple2 sql=simple
+ int Int
+ text Text
+ bool Bool
+ Primary text int
+ deriving Show Eq
+|]
+
+instance Arbitrary DataTypeTable 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
+
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+Test
+ time UTCTime
+|]
+
+setup :: MonadIO m => Migration -> ReaderT SqlBackend m ()
+setup migration = do
+ printMigration migration
+ runMigrationUnsafe migration
+
+main :: IO ()
+main = do
+ handle (\(_ :: IOException) -> return ())
+ $ removeFile $ fromText sqlite_database_file
+
+ runConn $ do
+ mapM_ setup
+ [ PersistentTest.testMigrate
+ , PersistentTest.noPrefixMigrate
+ , 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
+ ]
+ 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" (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
+ 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
+ TransactionLevelTest.specsWith db
+ MigrationTest.specsWith db
+
+ it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:")
$ do
+ runMigration 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
+ runMigration 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
+ runMigration 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
+ runMigration compositeSetup
+ runMigration compositeMigrateTest
+
+ it "afterException" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo
":memory:") $ do
+ runMigration 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 ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/test/sanity.hs
new/persistent-sqlite-2.10.5.2/test/sanity.hs
--- old/persistent-sqlite-2.9.2/test/sanity.hs 2018-07-15 06:56:03.000000000
+0200
+++ new/persistent-sqlite-2.10.5.2/test/sanity.hs 2019-05-07
01:24:32.000000000 +0200
@@ -1,9 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
-import Database.Persist.Sqlite
import Control.Monad.Logger
+import Database.Persist.Sqlite
+
$(return []) -- just force TH to run
main :: IO ()
-main = runStderrLoggingT $ withSqliteConn ":memory:" $ const $ return ()
+main = runStderrLoggingT $ withSqliteConn ":memory:" $ runSqlConn
waitForDatabase
