persistent-sqlite 2.2.1.1 → 2.5
raw patch · 5 files changed
+46/−31 lines, 5 filesdep +resource-pooldep ~persistent
Dependencies added: resource-pool
Dependency ranges changed: persistent
Files
- ChangeLog.md +6/−2
- Database/Persist/Sqlite.hs +19/−14
- Database/Sqlite.hs +18/−13
- cbits/sqlite3.c too large to diff
- persistent-sqlite.cabal +3/−2
ChangeLog.md view
@@ -1,6 +1,10 @@-## 2.2.1.1+## 2.5 -* Ensure connection is closed if wrapConnectionWal fails+* changes for read/write typeclass split++## 2.2.2++* Upgrade to SQLite 3.12.1 [#551](https://github.com/yesodweb/persistent/issues/551) ## 2.2.1
Database/Persist/Sqlite.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-}@@ -21,6 +22,7 @@ ) where import Database.Persist.Sql+import Database.Persist.Sql.Types.Internal (mkPersistBackend) import qualified Database.Sqlite as Sqlite @@ -41,10 +43,11 @@ import Control.Applicative import Data.Int (Int64) 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 (runReaderT)+import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Control.Monad.Trans.Writer (runWriterT) -- | Create a pool of SQLite connections.@@ -52,23 +55,24 @@ -- 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 :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => Text -> Int -> m ConnectionPool+createSqlitePool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, IsSqlBackend backend)+ => Text -> Int -> m (Pool backend) createSqlitePool s = createSqlPool $ open' s -- | Run the given action with a connection pool. -- -- Like 'createSqlitePool', this should not be used with @:memory:@.-withSqlitePool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m)+withSqlitePool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsSqlBackend backend) => Text -> Int -- ^ number of connections to open- -> (ConnectionPool -> m a) -> m a+ -> (Pool backend -> m a) -> m a withSqlitePool s = withSqlPool $ open' s -withSqliteConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m)- => Text -> (SqlBackend -> m a) -> m a+withSqliteConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, IsSqlBackend backend)+ => Text -> (backend -> m a) -> m a withSqliteConn = withSqlConn . open' -open' :: Text -> LogFunc -> IO SqlBackend+open' :: (IsSqlBackend backend) => Text -> LogFunc -> IO backend open' connStr logFunc = do let (connStr', enableWal) = case () of ()@@ -77,19 +81,20 @@ | otherwise -> (connStr, True) conn <- Sqlite.open connStr'- wrapConnectionWal enableWal conn logFunc `E.onException` Sqlite.close conn+ wrapConnectionWal enableWal conn logFunc -- | Wrap up a raw 'Sqlite.Connection' as a Persistent SQL 'Connection'. -- -- Since 1.1.5-wrapConnection :: Sqlite.Connection -> LogFunc -> IO SqlBackend+wrapConnection :: (IsSqlBackend backend) => Sqlite.Connection -> LogFunc -> IO backend wrapConnection = wrapConnectionWal True -- | Allow control of WAL settings when wrapping-wrapConnectionWal :: Bool -- ^ enable WAL?+wrapConnectionWal :: (IsSqlBackend backend)+ => Bool -- ^ enable WAL? -> Sqlite.Connection -> LogFunc- -> IO SqlBackend+ -> IO backend wrapConnectionWal enableWal conn logFunc = do when enableWal $ do -- Turn on the write-ahead log@@ -100,7 +105,7 @@ Sqlite.finalize turnOnWal smap <- newIORef $ Map.empty- return SqlBackend+ return . mkPersistBackend $ SqlBackend { connPrepare = prepare' conn , connStmtMap = smap , connInsertSql = insertSql'@@ -128,9 +133,9 @@ -- that all log messages are discarded. -- -- Since 1.1.4-runSqlite :: (MonadBaseControl IO m, MonadIO m)+runSqlite :: (MonadBaseControl IO m, MonadIO m, IsSqlBackend backend) => Text -- ^ connection string- -> SqlPersistT (NoLoggingT (ResourceT m)) a -- ^ database action+ -> ReaderT backend (NoLoggingT (ResourceT m)) a -- ^ database action -> m a runSqlite connstr = runResourceT . runNoLoggingT
Database/Sqlite.hs view
@@ -43,7 +43,9 @@ import Foreign import Foreign.C import Control.Exception (Exception, throwIO)+import Control.Applicative ((<$>)) 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)@@ -183,21 +185,24 @@ , seDetails = details } -foreign import ccall "sqlite3_open"- openC :: CString -> Ptr (Ptr ()) -> IO Int+foreign import ccall "sqlite3_open_v2"+ openC :: CString -> Ptr (Ptr ()) -> Int -> CString -> IO Int openError :: Text -> IO (Either Connection Error) openError path' = do- BS.useAsCString (encodeUtf8 path')- (\path -> do- alloca (\database -> do- error' <- openC path database- error <- return $ decodeError error'- case error of- ErrorOK -> do- database' <- peek database- active <- newIORef True- return $ Left $ Connection active $ Connection' database'- _ -> return $ Right error))+ let flag = sqliteFlagReadWrite .|. sqliteFlagCreate .|. sqliteFlagUri+ BS.useAsCString (encodeUtf8 path') $ \path -> alloca $ \database -> do+ err <- decodeError <$> openC path database flag nullPtr+ case err of+ ErrorOK -> do database' <- peek database+ active <- newIORef True+ return $ Left $ Connection active $ Connection' database'+ _ -> return $ Right err+ where+ -- for all sqlite flags, check out https://www.sqlite.org/c3ref/open.html+ sqliteFlagReadWrite = 0x2+ sqliteFlagCreate = 0x4+ sqliteFlagUri = 0x40+ open :: Text -> IO Connection open path = do databaseOrError <- openError path
cbits/sqlite3.c view
file too large to diff
persistent-sqlite.cabal view
@@ -1,5 +1,5 @@ name: persistent-sqlite-version: 2.2.1.1+version: 2.5 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -25,7 +25,7 @@ build-depends: base >= 4.6 && < 5 , bytestring >= 0.9.1 , transformers >= 0.2.1- , persistent >= 2.2 && < 3+ , persistent >= 2.5 && < 3 , monad-control >= 0.2 , containers >= 0.2 , text >= 0.7@@ -35,6 +35,7 @@ , resourcet >= 1.1 , time , old-locale+ , resource-pool exposed-modules: Database.Sqlite Database.Persist.Sqlite ghc-options: -Wall