persistent-sqlite 2.10.1 → 2.10.2

raw patch · 6 files changed

+187/−19 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• Database/Persist/Sqlite.hs +116/−12
• Database/Sqlite.hs +2/−6
• Database/Sqlite/Internal.hs +27/−0
• persistent-sqlite.cabal +12/−1
• test/main.hs +22/−0

@@ -1,5 +1,13 @@ # Changelog for persistent-sqlite +## 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)

@@ -1,7 +1,11 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}@@ -31,12 +35,16 @@     , mockMigration     , retryOnBusy     , waitForDatabase+    , RawSqlite+    , persistentBackend+    , rawSqliteConnection+    , withRawSqliteConnInfo     ) where  import Control.Concurrent (threadDelay) import qualified Control.Exception as E import Control.Monad (forM_)-import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withUnliftIO, unliftIO, withRunInIO)+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) import Control.Monad.Trans.Writer (runWriterT)@@ -58,7 +66,6 @@ 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 @@ -81,7 +88,7 @@ -- @since 2.6.2 createSqlitePoolFromInfo :: (MonadLogger m, MonadUnliftIO m)                          => SqliteConnectionInfo -> Int -> m (Pool SqlBackend)-createSqlitePoolFromInfo connInfo = createSqlPool $ open' connInfo+createSqlitePoolFromInfo connInfo = createSqlPool $ openWith const connInfo  -- | Run the given action with a connection pool. --@@ -90,7 +97,7 @@                => Text                -> Int -- ^ number of connections to open                -> (Pool SqlBackend -> m a) -> m a-withSqlitePool connInfo = withSqlPool . open' $ conStringToInfo connInfo+withSqlitePool connInfo = withSqlPool . openWith const $ conStringToInfo connInfo  -- | Run the given action with a connection pool. --@@ -101,7 +108,7 @@                    => SqliteConnectionInfo                    -> Int -- ^ number of connections to open                    -> (Pool SqlBackend -> m a) -> m a-withSqlitePoolInfo connInfo = withSqlPool $ open' connInfo+withSqlitePoolInfo connInfo = withSqlPool $ openWith const connInfo  withSqliteConn :: (MonadUnliftIO m, MonadLogger m)                => Text -> (SqlBackend -> m a) -> m a@@ -110,12 +117,16 @@ -- | @since 2.6.2 withSqliteConnInfo :: (MonadUnliftIO m, MonadLogger m)                    => SqliteConnectionInfo -> (SqlBackend -> m a) -> m a-withSqliteConnInfo = withSqlConn . open'+withSqliteConnInfo = withSqlConn . openWith const -open' :: SqliteConnectionInfo -> LogFunc -> IO SqlBackend-open' connInfo logFunc = do+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'. --@@ -463,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@@ -683,3 +697,93 @@         <*> o .: "walEnabled"         <*> o .: "fkEnabled"         <*> o .:? "extraPragmas" .!= []+++-- | 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 = liftPersist . get+    getMany = liftPersist . getMany++instance (PersistQueryRead b) => PersistQueryRead (RawSqlite b) where+    selectSourceRes filts opts = liftPersist $ selectSourceRes filts opts+    selectFirst filts opts = liftPersist $ selectFirst filts opts+    selectKeysRes filts opts = liftPersist $ selectKeysRes filts opts+    count = liftPersist . count++instance (PersistQueryWrite b) => PersistQueryWrite (RawSqlite b) where+    updateWhere filts updates = liftPersist $ updateWhere filts updates+    deleteWhere = liftPersist . deleteWhere++instance (PersistUniqueRead b) => PersistUniqueRead (RawSqlite b) where+    getBy = liftPersist . getBy++instance (PersistStoreWrite b) => PersistStoreWrite (RawSqlite b) where+    insert = liftPersist . insert+    insert_ = liftPersist . insert_+    insertMany = liftPersist . insertMany+    insertMany_ = liftPersist . insertMany_+    insertEntityMany = liftPersist . insertEntityMany+    insertKey k = liftPersist . insertKey k+    repsert k = liftPersist . repsert k+    repsertMany = liftPersist . repsertMany+    replace k = liftPersist . replace k+    delete = liftPersist . delete+    update k = liftPersist . update k+    updateGet k = liftPersist . updateGet k++instance (PersistUniqueWrite b) => PersistUniqueWrite (RawSqlite b) where+    deleteBy = liftPersist . deleteBy+    insertUnique = liftPersist . insertUnique+    upsert rec = liftPersist . upsert rec+    upsertBy uniq rec = liftPersist . upsertBy uniq rec+    putMany = liftPersist . putMany

@@ -86,22 +86,18 @@ import qualified Data.ByteString.Unsafe as BSU import qualified Data.ByteString.Internal as BSI import Data.Fixed (Pico)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)+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.Time (defaultTimeLocale, formatTime, UTCTime) import Data.Typeable (Typeable)+import Database.Sqlite.Internal (Connection(..), Connection'(..), Statement(..)) import Foreign import Foreign.C  import Database.Persist (PersistValue (..), listToJSON, mapToJSON)---data Connection = Connection !(IORef Bool) Connection'-newtype Connection' = Connection' (Ptr ())-newtype Statement = Statement (Ptr ())  -- | A custom exception type to make it easier to catch exceptions. --

@@ -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 ())

@@ -1,5 +1,5 @@ name:            persistent-sqlite-version:         2.10.1+version:         2.10.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -35,6 +35,12 @@ 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.9         && < 5@@ -53,6 +59,7 @@                    , unliftio-core                    , unordered-containers     exposed-modules: Database.Sqlite+                     Database.Sqlite.Internal                      Database.Persist.Sqlite     ghc-options:     -Wall     default-language: Haskell2010@@ -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 

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -78,6 +79,23 @@     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@@ -207,6 +225,10 @@     it "issue #527" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do         runMigration migrateAll         insertMany_ $ replicate 1000 (Test $ read "2014-11-30 05:15:25.123")++    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