Hello community,
here is the log from the commit of package ghc-persistent-sqlite for
openSUSE:Factory checked in at 2019-04-28 20:13:23
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent-sqlite (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.5536 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-sqlite"
Sun Apr 28 20:13:23 2019 rev:14 rq:698557 version:2.10.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-persistent-sqlite/ghc-persistent-sqlite.changes
2019-01-25 22:43:29.599218736 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new.5536/ghc-persistent-sqlite.changes
2019-04-28 20:13:25.810419346 +0200
@@ -1,0 +2,18 @@
+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.0.tar.gz
persistent-sqlite.cabal
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-sqlite.spec ++++++
--- /var/tmp/diff_new_pack.RnPU5N/_old 2019-04-28 20:13:28.766417508 +0200
+++ /var/tmp/diff_new_pack.RnPU5N/_new 2019-04-28 20:13:28.770417506 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-persistent-sqlite
#
-# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2019 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,13 +19,14 @@
%global pkg_name persistent-sqlite
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.9.2
+Version: 2.10.0
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
+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
@@ -33,7 +34,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 +46,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
@@ -71,9 +78,10 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cabal-tweak-flag systemlib True
+cp -p %{SOURCE1} %{pkg_name}.cabal
%build
+%define cabal_configure_options -fsystemlib
%ghc_lib_build
%install
++++++ persistent-sqlite-2.9.2.tar.gz -> persistent-sqlite-2.10.0.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.0/ChangeLog.md
--- old/persistent-sqlite-2.9.2/ChangeLog.md 2018-12-30 05:47:05.000000000
+0100
+++ new/persistent-sqlite-2.10.0/ChangeLog.md 2019-04-19 02:00:28.000000000
+0200
@@ -1,5 +1,15 @@
# Changelog for persistent-sqlite
+## 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.0/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.0/Database/Persist/Sqlite.hs 2019-04-19
02:00:43.000000000 +0200
@@ -1,11 +1,10 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 +29,16 @@
, wrapConnection
, wrapConnectionInfo
, mockMigration
+ , retryOnBusy
+ , waitForDatabase
) 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.IO.Unlift (MonadIO (..), MonadUnliftIO, withUnliftIO,
unliftIO, withRunInIO)
+import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger, logWarn,
runLoggingT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
-import UnliftIO.Resource (ResourceT, runResourceT)
import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
import Data.Aeson
@@ -61,14 +55,21 @@
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 Database.Persist.Sql.Types.Internal (mkPersistBackend)
+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,17 +79,17 @@
-- Instead, use 'withSqliteConn'.
--
-- @since 2.6.2
-createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m, IsSqlBackend
backend)
- => SqliteConnectionInfo -> Int -> m (Pool backend)
+createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)
+ => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)
createSqlitePoolFromInfo connInfo = createSqlPool $ open' 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
+ -> (Pool SqlBackend -> m a) -> m a
withSqlitePool connInfo = withSqlPool . open' $ conStringToInfo connInfo
-- | Run the given action with a connection pool.
@@ -96,22 +97,22 @@
-- 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 :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo
+ -> Int -- ^ number of connections to open
+ -> (Pool SqlBackend -> m a) -> m a
withSqlitePoolInfo connInfo = withSqlPool $ open' 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 :: (MonadUnliftIO m, MonadLogger m)
+ => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a
withSqliteConnInfo = withSqlConn . open'
-open' :: (IsSqlBackend backend) => SqliteConnectionInfo -> LogFunc -> IO
backend
+open' :: SqliteConnectionInfo -> LogFunc -> IO SqlBackend
open' connInfo logFunc = do
conn <- Sqlite.open $ _sqlConnectionStr connInfo
wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn
@@ -128,20 +129,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 +159,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 +264,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 +278,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
@@ -590,11 +625,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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/Database/Sqlite.hs
new/persistent-sqlite-2.10.0/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.0/Database/Sqlite.hs 2019-04-15
04:27:15.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,29 +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 (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 Foreign
+import Foreign.C
+
+import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
-#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 ())
@@ -198,7 +192,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 +200,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 +230,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 +474,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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.9.2/persistent-sqlite.cabal
new/persistent-sqlite-2.10.0/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.0/persistent-sqlite.cabal 2019-04-19
02:00:35.000000000 +0200
@@ -1,5 +1,5 @@
name: persistent-sqlite
-version: 2.9.2
+version: 2.10.0
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
@@ -37,25 +37,25 @@
default: True
library
- build-depends: base >= 4.8 && < 5
- , bytestring >= 0.9.1
- , transformers >= 0.2.1
+ build-depends: base >= 4.9 && < 5
, 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
+ , 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.Persist.Sqlite
ghc-options: -Wall
+ default-language: Haskell2010
if flag(systemlib)
if flag(use-pkgconfig)
pkgconfig-depends: sqlite3
@@ -86,21 +86,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 +93,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.0/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.0/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.0/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.0/test/SqliteInit.hs 2019-04-15
04:27:15.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.0/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.0/test/main.hs 2019-04-15 04:27:15.000000000
+0200
@@ -0,0 +1,218 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+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
+|]
+
+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.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")
+
+ 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.0/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.0/test/sanity.hs 2019-04-15 04:27:15.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
++++++ persistent-sqlite.cabal ++++++
name: persistent-sqlite
version: 2.10.0
x-revision: 1
license: MIT
license-file: LICENSE
author: Michael Snoyman <[email protected]>
maintainer: Michael Snoyman <[email protected]>
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
library
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
, 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.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
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
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
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
