From 05b598a0575e3ce58b3206e9964efd2aa6458ca5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 9 Dec 2015 14:55:47 -0400
Subject: [PATCH] stash DbHandle in Annex state

---
 Annex.hs                          |  3 +++
 Command/Smudge.hs                 |  6 ++----
 Database/AssociatedFiles.hs       | 33 +++++++++++++++++++++++--------
 Database/AssociatedFiles/Types.hs | 14 +++++++++++++
 Database/Handle.hs                |  4 ++--
 5 files changed, 46 insertions(+), 14 deletions(-)
 create mode 100644 Database/AssociatedFiles/Types.hs

diff --git a/Annex.hs b/Annex.hs
index c9a4ef6a05..5c9ec4cd41 100644
--- 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 f9f819bec5..7462963212 100644
--- 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 8244f15e80..d17eb8112d 100644
--- 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
index 0000000000..8c32dcf222
--- /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 439e7c18bc..6d312df685 100644
--- 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