stash DbHandle in Annex state

This commit is contained in:
Joey Hess 2015-12-09 14:55:47 -04:00
parent 78a6b8ce05
commit 05b598a057
Failed to extract signature
5 changed files with 46 additions and 14 deletions

View file

@ -60,6 +60,7 @@ import Types.NumCopies
import Types.LockCache import Types.LockCache
import Types.DesktopNotify import Types.DesktopNotify
import Types.CleanupActions import Types.CleanupActions
import qualified Database.AssociatedFiles.Types
#ifdef WITH_QUVI #ifdef WITH_QUVI
import Utility.Quvi (QuviVersion) import Utility.Quvi (QuviVersion)
#endif #endif
@ -134,6 +135,7 @@ data AnnexState = AnnexState
, desktopnotify :: DesktopNotify , desktopnotify :: DesktopNotify
, workers :: [Either AnnexState (Async AnnexState)] , workers :: [Either AnnexState (Async AnnexState)]
, concurrentjobs :: Maybe Int , concurrentjobs :: Maybe Int
, associatedfilesdbhandle :: Maybe Database.AssociatedFiles.Types.DbHandle
} }
newState :: GitConfig -> Git.Repo -> AnnexState newState :: GitConfig -> Git.Repo -> AnnexState
@ -179,6 +181,7 @@ newState c r = AnnexState
, desktopnotify = mempty , desktopnotify = mempty
, workers = [] , workers = []
, concurrentjobs = Nothing , concurrentjobs = Nothing
, associatedfilesdbhandle = Nothing
} }
{- Makes an Annex state object for the specified git repo. {- Makes an Annex state object for the specified git repo.

View file

@ -102,7 +102,5 @@ emitPointer = putStrLn . formatPointer
updateAssociatedFiles :: Key -> FilePath -> Annex () updateAssociatedFiles :: Key -> FilePath -> Annex ()
updateAssociatedFiles k f = do updateAssociatedFiles k f = do
h <- AssociatedFiles.openDb AssociatedFiles.addDb k f
liftIO $ do AssociatedFiles.flushDb
AssociatedFiles.addDb h k f
AssociatedFiles.closeDb h

View file

@ -13,6 +13,7 @@
module Database.AssociatedFiles ( module Database.AssociatedFiles (
DbHandle, DbHandle,
openDb, openDb,
flushDb,
closeDb, closeDb,
addDb, addDb,
getDb, getDb,
@ -21,6 +22,7 @@ module Database.AssociatedFiles (
) where ) where
import Database.Types import Database.Types
import Database.AssociatedFiles.Types
import qualified Database.Handle as H import qualified Database.Handle as H
import Locations import Locations
import Common hiding (delete) import Common hiding (delete)
@ -33,8 +35,6 @@ import Messages
import Database.Persist.TH import Database.Persist.TH
import Database.Esqueleto hiding (Key) import Database.Esqueleto hiding (Key)
newtype DbHandle = DbHandle H.DbHandle
share [mkPersist sqlSettings, mkMigrate "migrateAssociated"] [persistLowerCase| share [mkPersist sqlSettings, mkMigrate "migrateAssociated"] [persistLowerCase|
Associated Associated
key SKey key SKey
@ -64,8 +64,25 @@ openDb = withExclusiveLock gitAnnexAssociatedFilesDbLock $ do
closeDb :: DbHandle -> IO () closeDb :: DbHandle -> IO ()
closeDb (DbHandle h) = H.closeDb h closeDb (DbHandle h) = H.closeDb h
addDb :: DbHandle -> Key -> FilePath -> IO () withDbHandle :: (H.DbHandle -> IO a) -> Annex a
addDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $ do withDbHandle a = do
(DbHandle h) <- dbHandle
liftIO $ a h
dbHandle :: Annex DbHandle
dbHandle = maybe startup return =<< Annex.getState Annex.associatedfilesdbhandle
where
startup = do
h <- openDb
Annex.changeState $ \s -> s { Annex.associatedfilesdbhandle = Just h }
return h
{- Flushes any changes made to the database. -}
flushDb :: Annex ()
flushDb = withDbHandle H.flushQueueDb
addDb :: Key -> FilePath -> Annex ()
addDb k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
-- If the same file was associated with a different key before, -- If the same file was associated with a different key before,
-- remove that. -- remove that.
delete $ from $ \r -> do delete $ from $ \r -> do
@ -76,8 +93,8 @@ addDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $ do
{- Note that the files returned used to be associated with the key, but {- Note that the files returned used to be associated with the key, but
- some of them may not be any longer. -} - some of them may not be any longer. -}
getDb :: DbHandle -> Key -> IO [FilePath] getDb :: Key -> Annex [FilePath]
getDb (DbHandle h) = H.queryDb h . getDb' . toSKey getDb k = withDbHandle $ \h -> H.queryDb h $ getDb' $ toSKey k
getDb' :: SKey -> SqlPersistM [FilePath] getDb' :: SKey -> SqlPersistM [FilePath]
getDb' sk = do getDb' sk = do
@ -86,8 +103,8 @@ getDb' sk = do
return (r ^. AssociatedFile) return (r ^. AssociatedFile)
return $ map unValue l return $ map unValue l
removeDb :: DbHandle -> Key -> FilePath -> IO () removeDb :: Key -> FilePath -> Annex ()
removeDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $ removeDb k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
delete $ from $ \r -> do delete $ from $ \r -> do
where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f) where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
where where

View file

@ -0,0 +1,14 @@
{- Sqlite database used for tracking a key's associated files, data types.
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-:
- Licensed under the GNU GPL version 3 or higher.
-}
module Database.AssociatedFiles.Types (
DbHandle(..)
) where
import qualified Database.Handle as H
newtype DbHandle = DbHandle H.DbHandle

View file

@ -21,7 +21,6 @@ module Database.Handle (
import Utility.Exception import Utility.Exception
import Utility.Monad import Utility.Monad
import Messages
import Database.Persist.Sqlite import Database.Persist.Sqlite
import qualified Database.Sqlite as Sqlite import qualified Database.Sqlite as Sqlite
@ -35,6 +34,7 @@ import Control.Monad.Trans.Resource (runResourceT)
import Control.Monad.Logger (runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.List import Data.List
import Data.Time.Clock import Data.Time.Clock
import System.IO
{- A DbHandle is a reference to a worker thread that communicates with {- A DbHandle is a reference to a worker thread that communicates with
- the database. It has a MVar which Jobs are submitted to. -} - the database. It has a MVar which Jobs are submitted to. -}
@ -79,7 +79,7 @@ type TableName = String
workerThread :: T.Text -> TableName -> MVar Job -> IO () workerThread :: T.Text -> TableName -> MVar Job -> IO ()
workerThread db tablename jobs = catchNonAsync (run loop) showerr workerThread db tablename jobs = catchNonAsync (run loop) showerr
where where
showerr e = liftIO $ warningIO $ showerr e = liftIO $ hPutStrLn stderr $
"sqlite worker thread crashed: " ++ show e "sqlite worker thread crashed: " ++ show e
loop = do loop = do