Hello community,
here is the log from the commit of package ghc-persistent-sqlite for
openSUSE:Factory checked in at 2017-04-11 09:43:07
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent-sqlite (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-sqlite"
Tue Apr 11 09:43:07 2017 rev:6 rq:485153 version:2.6.2
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-persistent-sqlite/ghc-persistent-sqlite.changes
2017-03-20 17:07:48.164781326 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-persistent-sqlite.new/ghc-persistent-sqlite.changes
2017-04-11 09:43:10.649911299 +0200
@@ -1,0 +2,5 @@
+Tue Mar 14 09:26:02 UTC 2017 - [email protected]
+
+- Update to version 2.6.2 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
persistent-sqlite-2.6.0.1.tar.gz
New:
----
persistent-sqlite-2.6.2.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-sqlite.spec ++++++
--- /var/tmp/diff_new_pack.io1YV9/_old 2017-04-11 09:43:12.177695479 +0200
+++ /var/tmp/diff_new_pack.io1YV9/_new 2017-04-11 09:43:12.181694914 +0200
@@ -19,7 +19,7 @@
%global pkg_name persistent-sqlite
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.6.0.1
+Version: 2.6.2
Release: 0
Summary: Backend for the persistent library using sqlite3
License: MIT
@@ -31,6 +31,7 @@
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-conduit-devel
BuildRequires: ghc-containers-devel
+BuildRequires: ghc-microlens-th-devel
BuildRequires: ghc-monad-control-devel
BuildRequires: ghc-monad-logger-devel
BuildRequires: ghc-old-locale-devel
@@ -41,6 +42,7 @@
BuildRequires: ghc-text-devel
BuildRequires: ghc-time-devel
BuildRequires: ghc-transformers-devel
+BuildRequires: ghc-unordered-containers-devel
BuildRequires: glibc-devel
BuildRequires: sqlite3-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
++++++ persistent-sqlite-2.6.0.1.tar.gz -> persistent-sqlite-2.6.2.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.6.0.1/ChangeLog.md
new/persistent-sqlite-2.6.2/ChangeLog.md
--- old/persistent-sqlite-2.6.0.1/ChangeLog.md 2017-02-21 15:54:19.000000000
+0100
+++ new/persistent-sqlite-2.6.2/ChangeLog.md 2017-03-03 10:45:57.000000000
+0100
@@ -1,3 +1,12 @@
+## 2.6.2
+
+* Turned on foreign key constraints
[#646](https://github.com/yesodweb/persistent/issues/646)
+* Added new `SqliteConnectionInfo`-based API
+
+## 2.6.1
+
+* Added functions to monitor (status) and control (softHeapLimit) process-wide
SQLite memory usage.
+
## 2.6.0.1
* Ensure connection is closed if wrapConnectionWal fails
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.6.0.1/Database/Persist/Sqlite.hs
new/persistent-sqlite-2.6.2/Database/Persist/Sqlite.hs
--- old/persistent-sqlite-2.6.0.1/Database/Persist/Sqlite.hs 2017-02-21
15:54:19.000000000 +0100
+++ new/persistent-sqlite-2.6.2/Database/Persist/Sqlite.hs 2017-03-03
10:45:57.000000000 +0100
@@ -4,20 +4,30 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternGuards #-}
-- | A sqlite backend for persistent.
--
-- Note: If you prepend @WAL=off @ to your connection string, it will disable
--- the write-ahead log. For more information, see
--- <https://github.com/yesodweb/persistent/issues/363>.
+-- the write-ahead log. This functionality is now deprecated in favour of
using SqliteConnectionInfo.
module Database.Persist.Sqlite
( withSqlitePool
+ , withSqlitePoolInfo
, withSqliteConn
+ , withSqliteConnInfo
, createSqlitePool
+ , createSqlitePoolFromInfo
, module Database.Persist.Sql
, SqliteConf (..)
+ , SqliteConnectionInfo
+ , mkSqliteConnectionInfo
+ , sqlConnectionStr
+ , walEnabled
+ , fkEnabled
, runSqlite
+ , runSqliteInfo
, wrapConnection
+ , wrapConnectionInfo
, mockMigration
) where
@@ -26,29 +36,31 @@
import qualified Database.Sqlite as Sqlite
+import Control.Applicative as A
+import qualified Control.Exception as E
+import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Logger (NoLoggingT, runNoLoggingT, MonadLogger)
-import Data.IORef
-import qualified Data.Map as Map
import Control.Monad.Trans.Control (control)
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Control.Monad.Trans.Resource (ResourceT, runResourceT)
+import Control.Monad.Trans.Writer (runWriterT)
import Data.Acquire (Acquire, mkAcquire, with)
-import qualified Control.Exception as E
-import Data.Text (Text)
import Data.Aeson
import Data.Aeson.Types (modifyFailure)
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
import Data.Conduit
import qualified Data.Conduit.List as CL
-import Control.Applicative
+import qualified Data.HashMap.Lazy as HashMap
import Data.Int (Int64)
+import Data.IORef
+import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Pool (Pool)
-import Control.Monad.Trans.Control (MonadBaseControl)
-import Control.Monad.Trans.Resource (ResourceT, runResourceT)
-import Control.Monad (when)
-import Control.Monad.Trans.Reader (ReaderT, runReaderT)
-import Control.Monad.Trans.Writer (runWriterT)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Lens.Micro.TH (makeLenses)
-- | Create a pool of SQLite connections.
--
@@ -57,7 +69,18 @@
-- Instead, use 'withSqliteConn'.
createSqlitePool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m,
IsSqlBackend backend)
=> Text -> Int -> m (Pool backend)
-createSqlitePool s = createSqlPool $ open' s
+createSqlitePool = createSqlitePoolFromInfo . conStringToInfo
+
+-- | 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'.
+--
+-- @since 2.6.2
+createSqlitePoolFromInfo :: (MonadIO m, MonadLogger m, MonadBaseControl IO m,
IsSqlBackend backend)
+ => SqliteConnectionInfo -> Int -> m (Pool backend)
+createSqlitePoolFromInfo connInfo = createSqlPool $ open' connInfo
-- | Run the given action with a connection pool.
--
@@ -66,37 +89,50 @@
=> Text
-> Int -- ^ number of connections to open
-> (Pool backend -> m a) -> m a
-withSqlitePool s = withSqlPool $ open' s
+withSqlitePool connInfo = withSqlPool . open' $ conStringToInfo connInfo
+
+-- | Run the given action with a connection pool.
+--
+-- Like 'createSqlitePool', this should not be used with @:memory:@.
+--
+-- @since 2.6.2
+withSqlitePoolInfo :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
IsSqlBackend backend)
+ => SqliteConnectionInfo
+ -> Int -- ^ number of connections to open
+ -> (Pool backend -> m a) -> m a
+withSqlitePoolInfo connInfo = withSqlPool $ open' connInfo
withSqliteConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m,
IsSqlBackend backend)
=> Text -> (backend -> m a) -> m a
-withSqliteConn = withSqlConn . open'
+withSqliteConn = withSqliteConnInfo . conStringToInfo
-open' :: (IsSqlBackend backend) => Text -> LogFunc -> IO backend
-open' connStr logFunc = do
- let (connStr', enableWal) = case () of
- ()
- | Just cs <- T.stripPrefix "WAL=on " connStr -> (cs, True)
- | Just cs <- T.stripPrefix "WAL=off " connStr -> (cs, False)
- | otherwise -> (connStr, True)
-
- conn <- Sqlite.open connStr'
- wrapConnectionWal enableWal conn logFunc `E.onException` Sqlite.close conn
+-- | @since 2.6.2
+withSqliteConnInfo :: (MonadBaseControl IO m, MonadIO 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
+ conn <- Sqlite.open $ _sqlConnectionStr connInfo
+ wrapConnectionInfo connInfo conn logFunc `E.onException` Sqlite.close conn
-- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL 'Connection'.
--
-- Since 1.1.5
wrapConnection :: (IsSqlBackend backend) => Sqlite.Connection -> LogFunc -> IO
backend
-wrapConnection = wrapConnectionWal True
+wrapConnection = wrapConnectionInfo (mkSqliteConnectionInfo "")
--- | Allow control of WAL settings when wrapping
-wrapConnectionWal :: (IsSqlBackend backend)
- => Bool -- ^ enable WAL?
+-- | 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
-wrapConnectionWal enableWal conn logFunc = do
- when enableWal $ do
+wrapConnectionInfo connInfo conn logFunc = do
+ when (_walEnabled connInfo) $ do
-- Turn on the write-ahead log
-- https://github.com/yesodweb/persistent/issues/363
turnOnWal <- Sqlite.prepare conn "PRAGMA journal_mode=WAL;"
@@ -104,6 +140,14 @@
Sqlite.reset conn turnOnWal
Sqlite.finalize turnOnWal
+ when (_fkEnabled connInfo) $ do
+ -- Turn on foreign key constraints
+ -- https://github.com/yesodweb/persistent/issues/646
+ turnOnFK <- Sqlite.prepare conn "PRAGMA foreign_keys = on;"
+ _ <- Sqlite.step turnOnFK
+ Sqlite.reset conn turnOnFK
+ Sqlite.finalize turnOnFK
+
smap <- newIORef $ Map.empty
return . mkPersistBackend $ SqlBackend
{ connPrepare = prepare' conn
@@ -121,6 +165,7 @@
, connRDBMS = "sqlite"
, connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"
, connLogFunc = logFunc
+ , connMaxParams = Just 999
}
where
helper t getter = do
@@ -143,6 +188,20 @@
. withSqliteConn connstr
. runSqlConn
+-- | A convenience helper which creates a new database connection and runs the
+-- given block, handling @MonadResource@ and @MonadLogger@ requirements. Note
+-- that all log messages are discarded.
+--
+-- @since 2.6.2
+runSqliteInfo :: (MonadBaseControl IO m, MonadIO m, IsSqlBackend backend)
+ => SqliteConnectionInfo
+ -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database
action
+ -> m a
+runSqliteInfo conInfo = runResourceT
+ . runNoLoggingT
+ . withSqliteConnInfo conInfo
+ . runSqlConn
+
prepare' :: Sqlite.Connection -> Text -> IO Statement
prepare' conn sql = do
stmt <- Sqlite.prepare conn sql
@@ -285,6 +344,8 @@
, connRDBMS = "sqlite"
, connLimitOffset = decorateSQLWithLimitOffset "LIMIT -1"
, connLogFunc = undefined
+ , connUpsertSql = undefined
+ , connMaxParams = Just 999
}
result = runReaderT . runWriterT . runWriterT $ mig
resp <- result sqlbackend
@@ -426,21 +487,31 @@
go '"' = "\"\""
go c = T.singleton c
--- | Information required to connect to a sqlite database
+-- | Information required to setup a connection pool.
data SqliteConf = SqliteConf
{ sqlDatabase :: Text
, sqlPoolSize :: Int
+ }
+ | SqliteConfInfo
+ { sqlConnInfo :: SqliteConnectionInfo
+ , sqlPoolSize :: Int
} deriving Show
instance FromJSON SqliteConf where
- parseJSON v = modifyFailure ("Persistent: error loading Sqlite conf: " ++)
$
- flip (withObject "SqliteConf") v $ \o -> SqliteConf
- <$> o .: "database"
- <*> o .: "poolsize"
+ 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"
+ else SqliteConfInfo
+ A.<$> o .: "connInfo"
+ A.<*> o .: "poolsize"
+
instance PersistConfig SqliteConf where
type PersistConfigBackend SqliteConf = SqlPersistT
type PersistConfigPool SqliteConf = ConnectionPool
- createPoolConfig (SqliteConf cs size) = runNoLoggingT $ createSqlitePool
cs size -- FIXME
+ createPoolConfig (SqliteConf cs size) = runNoLoggingT $
createSqlitePoolFromInfo (conStringToInfo cs) size -- FIXME
+ createPoolConfig (SqliteConfInfo info size) = runNoLoggingT $
createSqlitePoolFromInfo info size -- FIXME
runPool _ = runSqlPool
loadConfig = parseJSON
@@ -452,3 +523,37 @@
E.finally (runInIO a)
(runInIO sequel)
{-# INLINABLE finally #-}
+-- | Creates a SqliteConnectionInfo from a connection string, with the
+-- default settings.
+--
+-- @since 2.6.2
+mkSqliteConnectionInfo :: Text -> SqliteConnectionInfo
+mkSqliteConnectionInfo fp = SqliteConnectionInfo fp True True
+
+-- | Parses connection options from a connection string. Used only to provide
deprecated API.
+conStringToInfo :: Text -> SqliteConnectionInfo
+conStringToInfo connStr = SqliteConnectionInfo connStr' enableWal True where
+ (connStr', enableWal) = case () of
+ ()
+ | Just cs <- T.stripPrefix "WAL=on " connStr -> (cs, True)
+ | Just cs <- T.stripPrefix "WAL=off " connStr -> (cs, False)
+ | otherwise -> (connStr, True)
+
+-- | Information required to connect to a sqlite database. We export
+-- lenses instead of fields to avoid being limited to the current
+-- implementation.
+--
+-- @since 2.6.2
+data SqliteConnectionInfo = SqliteConnectionInfo
+ { _sqlConnectionStr :: Text -- ^ connection string for the database. Use
@:memory:@ for an in-memory database.
+ , _walEnabled :: Bool -- ^ if the write-ahead log is enabled - see
https://github.com/yesodweb/persistent/issues/363.
+ , _fkEnabled :: Bool -- ^ if foreign-key constraints are enabled.
+ } deriving Show
+makeLenses ''SqliteConnectionInfo
+
+instance FromJSON SqliteConnectionInfo where
+ parseJSON v = modifyFailure ("Persistent: error loading
SqliteConnectionInfo: " ++) $
+ flip (withObject "SqliteConnectionInfo") v $ \o -> SqliteConnectionInfo
+ <$> o .: "connectionString"
+ <*> o .: "walEnabled"
+ <*> o .: "fkEnabled"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.6.0.1/Database/Sqlite.hs
new/persistent-sqlite-2.6.2/Database/Sqlite.hs
--- old/persistent-sqlite-2.6.0.1/Database/Sqlite.hs 2017-02-21
15:54:19.000000000 +0100
+++ new/persistent-sqlite-2.6.2/Database/Sqlite.hs 2017-03-01
07:48:55.000000000 +0100
@@ -12,6 +12,8 @@
Done),
Config(ConfigLogFn),
LogFunction,
+ SqliteStatus (..),
+ SqliteStatusVerb (..),
open,
close,
prepare,
@@ -30,7 +32,9 @@
changes,
mkLogFunction,
freeLogFunction,
- config
+ config,
+ status,
+ softHeapLimit
)
where
@@ -43,9 +47,8 @@
import Foreign
import Foreign.C
import Control.Exception (Exception, throwIO)
-import Control.Applicative ((<$>))
+import Control.Applicative as A ((<$>))
import Database.Persist (PersistValue (..), listToJSON, mapToJSON)
-import Data.Bits ((.|.))
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
@@ -75,7 +78,7 @@
}
deriving (Typeable)
instance Show SqliteException where
- show (SqliteException error functionName details) = unpack $ mconcat
+ show (SqliteException error functionName details) = unpack $
Data.Monoid.mconcat
["SQLite3 returned "
, pack $ show error
, " while attempting to perform "
@@ -177,7 +180,7 @@
details <- case maybeConnection of
Just database -> do
details <- errmsg database
- return $ ": " `mappend` details
+ return $ ": " `Data.Monoid.mappend` details
Nothing -> return "."
throwIO SqliteException
{ seError = error
@@ -191,7 +194,7 @@
openError path' = do
let flag = sqliteFlagReadWrite .|. sqliteFlagCreate .|. sqliteFlagUri
BS.useAsCString (encodeUtf8 path') $ \path -> alloca $ \database -> do
- err <- decodeError <$> openC path database flag nullPtr
+ err <- decodeError A.<$> openC path database flag nullPtr
case err of
ErrorOK -> do database' <- peek database
active <- newIORef True
@@ -532,4 +535,115 @@
ErrorOK -> return ()
_ -> sqlError Nothing "sqlite3_config" e
+-- | Return type of the 'status' function
+--
+-- Since 2.6.1
+data SqliteStatus = SqliteStatus
+ { sqliteStatusCurrent :: Maybe Int
+ -- ^ The current value of the parameter. Some parameters do not record
current value.
+ , sqliteStatusHighwater :: Maybe Int
+ -- ^ The highest recorded value. Some parameters do not record the highest
value.
+ } deriving (Eq, Show)
+-- | Run-time status parameter that can be returned by 'status' function.
+--
+-- Since 2.6.1
+data SqliteStatusVerb
+ -- | This parameter is the current amount of memory checked out using
sqlite3_malloc(),
+ -- either directly or indirectly. The figure includes calls made to
sqlite3_malloc()
+ -- by the application and internal memory usage by the SQLite library.
Scratch memory
+ -- controlled by SQLITE_CONFIG_SCRATCH and auxiliary page-cache memory
controlled by
+ -- SQLITE_CONFIG_PAGECACHE is not included in this parameter. The amount
returned is
+ -- the sum of the allocation sizes as reported by the xSize method in
sqlite3_mem_methods.
+ = SqliteStatusMemoryUsed
+ -- | This parameter returns the number of pages used out of the pagecache
memory
+ -- allocator that was configured using SQLITE_CONFIG_PAGECACHE. The value
returned
+ -- is in pages, not in bytes.
+ | SqliteStatusPagecacheUsed
+ -- | This parameter returns the number of bytes of page cache allocation
which
+ -- could not be satisfied by the SQLITE_CONFIG_PAGECACHE buffer and where
forced
+ -- to overflow to sqlite3_malloc(). The returned value includes allocations
that
+ -- overflowed because they where too large (they were larger than the "sz"
+ -- parameter to SQLITE_CONFIG_PAGECACHE) and allocations that overflowed
because
+ -- no space was left in the page cache.
+ | SqliteStatusPagecacheOverflow
+ -- | This parameter returns the number of allocations used out of the scratch
+ -- memory allocator configured using SQLITE_CONFIG_SCRATCH. The value
returned
+ -- is in allocations, not in bytes. Since a single thread may only have one
+ -- scratch allocation outstanding at time, this parameter also reports the
+ -- number of threads using scratch memory at the same time.
+ | SqliteStatusScratchUsed
+ -- | This parameter returns the number of bytes of scratch memory allocation
+ -- which could not be satisfied by the SQLITE_CONFIG_SCRATCH buffer and where
+ -- forced to overflow to sqlite3_malloc(). The values returned include
overflows
+ -- because the requested allocation was too larger (that is, because the
requested
+ -- allocation was larger than the "sz" parameter to SQLITE_CONFIG_SCRATCH)
and
+ -- because no scratch buffer slots were available.
+ | SqliteStatusScratchOverflow
+ -- | This parameter records the largest memory allocation request handed to
+ -- sqlite3_malloc() or sqlite3_realloc() (or their internal equivalents).
Only
+ -- the value returned in 'sqliteStatusHighwater' field of 'SqliteStatus'
record
+ -- is of interest. The value written into the 'sqliteStatusCurrent' field is
Nothing.
+ | SqliteStatusMallocSize
+ -- | This parameter records the largest memory allocation request handed to
+ -- pagecache memory allocator. Only the value returned in the
'sqliteStatusHighwater'
+ -- field of 'SqliteStatus' record is of interest. The value written into the
+ -- 'sqliteStatusCurrent' field is Nothing.
+ | SqliteStatusPagecacheSize
+ -- | This parameter records the largest memory allocation request handed to
+ -- scratch memory allocator. Only the value returned in the
'sqliteStatusHighwater'
+ -- field of 'SqliteStatus' record is of interest. The value written into the
+ -- 'sqliteStatusCurrent' field is Nothing.
+ | SqliteStatusScratchSize
+ -- | This parameter records the number of separate memory allocations
currently
+ -- checked out.
+ | SqliteStatusMallocCount
+
+-- Internal function to convert status parameter to a triple of its integral
+-- constant and two bools indicating if native sqlite3_status function actually
+-- modifies values at pCurrent and pHighwater pointers.
+statusVerbInfo :: SqliteStatusVerb -> (CInt, Bool, Bool)
+statusVerbInfo v = case v of
+ SqliteStatusMemoryUsed -> (0, True, True)
+ SqliteStatusPagecacheUsed -> (1, True, True)
+ SqliteStatusPagecacheOverflow -> (2, True, True)
+ SqliteStatusScratchUsed -> (3, True, True)
+ SqliteStatusScratchOverflow -> (4, True, True)
+ SqliteStatusMallocSize -> (5, False, True)
+ SqliteStatusPagecacheSize -> (7, False, True)
+ SqliteStatusScratchSize -> (8, False, True)
+ SqliteStatusMallocCount -> (9, True, True)
+
+foreign import ccall "sqlite3_status"
+ statusC :: CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO Int
+
+-- | Retrieves runtime status information about the performance of SQLite,
+-- and optionally resets various highwater marks. The first argument is a
+-- status parameter to measure, the second is reset flag. If reset flag is
+-- True then the highest recorded value is reset after being returned from
+-- this function.
+--
+-- Since 2.6.1
+status :: SqliteStatusVerb -> Bool -> IO SqliteStatus
+status verb reset' = alloca $ \pCurrent -> alloca $ \pHighwater -> do
+ let (code, hasCurrent, hasHighwater) = statusVerbInfo verb
+ e <- decodeError <$> statusC code pCurrent pHighwater (if reset' then 1 else
0)
+ case e of
+ ErrorOK -> do
+ current <- if hasCurrent then Just . fromIntegral <$> peek pCurrent else
return Nothing
+ highwater <- if hasHighwater then Just . fromIntegral <$> peek
pHighwater else return Nothing
+ return $ SqliteStatus current highwater
+ _ -> sqlError Nothing "sqlite3_status" e
+
+foreign import ccall "sqlite3_soft_heap_limit64"
+ softHeapLimit64C :: CLLong -> IO CLLong
+
+-- | Sets and/or queries the soft limit on the amount of heap memory that may
be
+-- allocated by SQLite. If the argument is zero then the soft heap limit is
disabled.
+-- If the argument is negative then no change is made to the soft heap limit.
Hence,
+-- the current size of the soft heap limit can be determined by invoking
+-- this function with a negative argument.
+--
+-- Since 2.6.1
+softHeapLimit :: Int64 -> IO Int64
+softHeapLimit x = fromIntegral <$> softHeapLimit64C (CLLong x)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.6.0.1/persistent-sqlite.cabal
new/persistent-sqlite-2.6.2/persistent-sqlite.cabal
--- old/persistent-sqlite-2.6.0.1/persistent-sqlite.cabal 2017-02-21
15:54:19.000000000 +0100
+++ new/persistent-sqlite-2.6.2/persistent-sqlite.cabal 2017-03-03
10:45:57.000000000 +0100
@@ -1,5 +1,5 @@
name: persistent-sqlite
-version: 2.6.0.1
+version: 2.6.2
license: MIT
license-file: LICENSE
author: Michael Snoyman <[email protected]>
@@ -25,17 +25,19 @@
build-depends: base >= 4.6 && < 5
, bytestring >= 0.9.1
, transformers >= 0.2.1
- , persistent >= 2.6 && < 3
+ , persistent >= 2.6.1 && < 3
, monad-control >= 0.2
, containers >= 0.2
, text >= 0.7
, aeson >= 0.6.2
, conduit >= 0.5.3
, monad-logger >= 0.2.4
+ , microlens-th >= 0.4.1.1
, resourcet >= 1.1
, time
, old-locale
, resource-pool
+ , unordered-containers
exposed-modules: Database.Sqlite
Database.Persist.Sqlite
ghc-options: -Wall
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-sqlite-2.6.0.1/test/Spec.hs
new/persistent-sqlite-2.6.2/test/Spec.hs
--- old/persistent-sqlite-2.6.0.1/test/Spec.hs 2017-02-21 15:54:19.000000000
+0100
+++ new/persistent-sqlite-2.6.2/test/Spec.hs 2017-03-03 10:45:57.000000000
+0100
@@ -6,6 +6,11 @@
{-# 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
@@ -13,9 +18,9 @@
import Database.Persist.Sqlite
import Database.Persist.TH
import qualified Database.Sqlite as Sqlite
-import Test.Hspec
import System.IO (hClose)
import System.IO.Temp (withSystemTempFile)
+import Test.Hspec
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Test
@@ -27,12 +32,12 @@
main :: IO ()
main = hspec $ do
- it "issue #328" $ asIO $ runSqlite ":memory:" $ do
+ it "issue #328" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:")
$ do
runMigration migrateAll
- insert . Test $ read "2014-11-30 05:15:25.123"
+ _ <- 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 $ runSqlite ":memory:" $ do
+ it "issue #339" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:")
$ do
runMigration migrateAll
now <- liftIO getCurrentTime
tid <- insert $ Test now
@@ -43,3 +48,6 @@
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")
