Fix build with persistent-sqlite older than 2.6.3.
This commit was sponsored by Jack Hill on Patreon.
This commit is contained in:
parent
4623a037f5
commit
f78f97780c
3 changed files with 31 additions and 6 deletions
|
@ -4,6 +4,7 @@ git-annex (7.20181106) UNRELEASED; urgency=medium
|
||||||
different clients at the same time. (Or when annex.pidlock is used,
|
different clients at the same time. (Or when annex.pidlock is used,
|
||||||
two different objects.)
|
two different objects.)
|
||||||
* Fixed some other potential hangs in the P2P protocol.
|
* Fixed some other potential hangs in the P2P protocol.
|
||||||
|
* Fix build with persistent-sqlite older than 2.6.3.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Tue, 06 Nov 2018 12:44:27 -0400
|
-- Joey Hess <id@joeyh.name> Tue, 06 Nov 2018 12:44:27 -0400
|
||||||
|
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module Database.Init where
|
module Database.Init where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
|
@ -14,7 +16,11 @@ import Utility.FileMode
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
#if MIN_VERSION_persistent_sqlite(2,6,2)
|
||||||
import Lens.Micro
|
import Lens.Micro
|
||||||
|
#else
|
||||||
|
import qualified Database.Sqlite as Sqlite
|
||||||
|
#endif
|
||||||
|
|
||||||
{- Ensures that the database is freshly initialized. Deletes any
|
{- Ensures that the database is freshly initialized. Deletes any
|
||||||
- existing database. Pass the migration action for the database.
|
- existing database. Pass the migration action for the database.
|
||||||
|
@ -29,9 +35,15 @@ initDb db migration = do
|
||||||
let dbdir = takeDirectory db
|
let dbdir = takeDirectory db
|
||||||
let tmpdbdir = dbdir ++ ".tmp"
|
let tmpdbdir = dbdir ++ ".tmp"
|
||||||
let tmpdb = tmpdbdir </> "db"
|
let tmpdb = tmpdbdir </> "db"
|
||||||
|
let tdb = T.pack tmpdb
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
createDirectoryIfMissing True tmpdbdir
|
createDirectoryIfMissing True tmpdbdir
|
||||||
runSqliteInfo (mkConnInfo tmpdb) migration
|
#if MIN_VERSION_persistent_sqlite(2,6,2)
|
||||||
|
runSqliteInfo (enableWAL tdb) migration
|
||||||
|
#else
|
||||||
|
enableWAL tdb
|
||||||
|
runSqlite tdb migration
|
||||||
|
#endif
|
||||||
setAnnexDirPerm tmpdbdir
|
setAnnexDirPerm tmpdbdir
|
||||||
-- Work around sqlite bug that prevents it from honoring
|
-- Work around sqlite bug that prevents it from honoring
|
||||||
-- less restrictive umasks.
|
-- less restrictive umasks.
|
||||||
|
@ -44,11 +56,21 @@ initDb db migration = do
|
||||||
{- Make sure that the database uses WAL mode, to prevent readers
|
{- Make sure that the database uses WAL mode, to prevent readers
|
||||||
- from blocking writers, and prevent a writer from blocking readers.
|
- from blocking writers, and prevent a writer from blocking readers.
|
||||||
-
|
-
|
||||||
- This is the default in persistent-sqlite currently, but force it on just
|
- This is the default in recent persistent-sqlite versions, but
|
||||||
- in case.
|
- force it on just in case.
|
||||||
-
|
-
|
||||||
- Note that once WAL mode is enabled, it will persist whenever the
|
- Note that once WAL mode is enabled, it will persist whenever the
|
||||||
- database is opened. -}
|
- database is opened. -}
|
||||||
mkConnInfo :: FilePath -> SqliteConnectionInfo
|
#if MIN_VERSION_persistent_sqlite(2,6,2)
|
||||||
mkConnInfo db = over walEnabled (const True) $
|
enableWAL :: T.Text -> SqliteConnectionInfo
|
||||||
mkSqliteConnectionInfo (T.pack db)
|
enableWAL db = over walEnabled (const True) $
|
||||||
|
mkSqliteConnectionInfo db
|
||||||
|
#else
|
||||||
|
enableWAL :: T.Text -> IO ()
|
||||||
|
enableWAL db = do
|
||||||
|
conn <- Sqlite.open db
|
||||||
|
stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")
|
||||||
|
void $ Sqlite.step stmt
|
||||||
|
void $ Sqlite.finalize stmt
|
||||||
|
Sqlite.close conn
|
||||||
|
#endif
|
||||||
|
|
|
@ -8,3 +8,5 @@
|
||||||
Backporting recent persistent-sqlite to stretch is highly unlikely to succeed, given how tangled Haskell library dependencies tend to be. So, unless there is an easy fix for this, git-annex will have to be removed from stretch-backports. That would be a shame, but I guess buster isn't so far away now!
|
Backporting recent persistent-sqlite to stretch is highly unlikely to succeed, given how tangled Haskell library dependencies tend to be. So, unless there is an easy fix for this, git-annex will have to be removed from stretch-backports. That would be a shame, but I guess buster isn't so far away now!
|
||||||
|
|
||||||
--spwhitton
|
--spwhitton
|
||||||
|
|
||||||
|
> [[fixed|done]] --[[Joey]]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue