stash DbHandle in Annex state

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.

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

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

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

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