stash DbHandle in Annex state
This commit is contained in:
parent
78a6b8ce05
commit
05b598a057
5 changed files with 46 additions and 14 deletions
3
Annex.hs
3
Annex.hs
|
@ -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.
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
14
Database/AssociatedFiles/Types.hs
Normal file
14
Database/AssociatedFiles/Types.hs
Normal 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
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue