stash DbHandle in Annex state

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

diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index f9f819bec5518dcaf2b9aa5e5306eec84d0087d6..7462963212d31bc77cc3648494156a67b6c2a0c6 100644 (file)
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -102,7 +102,5 @@ emitPointer = putStrLn . formatPointer
 
 updateAssociatedFiles :: Key -> FilePath -> Annex ()
 updateAssociatedFiles k f = do
-       h <- AssociatedFiles.openDb
-       liftIO $ do
-               AssociatedFiles.addDb h k f
-               AssociatedFiles.closeDb h
+       AssociatedFiles.addDb k f
+       AssociatedFiles.flushDb

diff --git a/Database/AssociatedFiles.hs b/Database/AssociatedFiles.hs
index 8244f15e8044cc41bcb2a74491fec669ecc2c9aa..d17eb8112dae4d6ed3441a898e06e64b50485c55 100644 (file)
--- a/Database/AssociatedFiles.hs
+++ b/Database/AssociatedFiles.hs
@@ -13,6 +13,7 @@
 module Database.AssociatedFiles (
        DbHandle,
        openDb,
+       flushDb,
        closeDb,
        addDb,
        getDb,
@@ -21,6 +22,7 @@ module Database.AssociatedFiles (
 ) where
 
 import Database.Types
+import Database.AssociatedFiles.Types
 import qualified Database.Handle as H
 import Locations
 import Common hiding (delete)
@@ -33,8 +35,6 @@ import Messages
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
 
-newtype DbHandle = DbHandle H.DbHandle
-
 share [mkPersist sqlSettings, mkMigrate "migrateAssociated"] [persistLowerCase|
 Associated
   key SKey
@@ -64,8 +64,25 @@ openDb = withExclusiveLock gitAnnexAssociatedFilesDbLock $ do
 closeDb :: DbHandle -> IO ()
 closeDb (DbHandle h) = H.closeDb h
 
-addDb :: DbHandle -> Key -> FilePath -> IO ()
-addDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $ do
+withDbHandle :: (H.DbHandle -> IO a) -> Annex a
+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,
        -- remove that.
        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
  - some of them may not be any longer. -}
-getDb :: DbHandle -> Key -> IO [FilePath]
-getDb (DbHandle h) = H.queryDb h . getDb' . toSKey
+getDb :: Key -> Annex [FilePath]
+getDb k = withDbHandle $ \h -> H.queryDb h $ getDb' $ toSKey k
 
 getDb' :: SKey -> SqlPersistM [FilePath]
 getDb' sk = do
@@ -86,8 +103,8 @@ getDb' sk = do
                return (r ^. AssociatedFile)
        return $ map unValue l
 
-removeDb :: DbHandle -> Key -> FilePath -> IO ()
-removeDb (DbHandle h) k f =  H.queueDb h (\_ _ -> pure True) $
+removeDb :: Key -> FilePath -> Annex ()
+removeDb k f =  withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
        delete $ from $ \r -> do
                where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
   where

diff --git a/Database/AssociatedFiles/Types.hs b/Database/AssociatedFiles/Types.hs
new file mode 100644 (file)
index 0000000..8c32dcf
--- /dev/null
+++ b/Database/AssociatedFiles/Types.hs
@@ -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

diff --git a/Database/Handle.hs b/Database/Handle.hs
index 439e7c18bc4f143c0f45fc5706600f7f2de28069..6d312df685b9232fdf5790655d1a06dc8fdcd7bb 100644 (file)
--- a/Database/Handle.hs
+++ b/Database/Handle.hs
@@ -21,7 +21,6 @@ module Database.Handle (
 
 import Utility.Exception
 import Utility.Monad
-import Messages
 
 import Database.Persist.Sqlite
 import qualified Database.Sqlite as Sqlite
@@ -35,6 +34,7 @@ import Control.Monad.Trans.Resource (runResourceT)
 import Control.Monad.Logger (runNoLoggingT)
 import Data.List
 import Data.Time.Clock
+import System.IO
 
 {- A DbHandle is a reference to a worker thread that communicates with
  - 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 db tablename jobs = catchNonAsync (run loop) showerr
   where
-       showerr e = liftIO $ warningIO $
+       showerr e = liftIO $ hPutStrLn stderr $
                "sqlite worker thread crashed: " ++ show e
        
        loop = do