diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-09-18 18:40:16 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-09-18 19:21:41 -0400 |
commit | 36533ce176ec653f62fe740f9907f527e4f36361 (patch) | |
tree | 0c507668c7d19950efa7877ca2155e71ccdb1472 /Database | |
parent | 7576fff0131d4f86dc495d58f62490c3264e0e54 (diff) |
merge changes made on other repos into ExportTree
Now when one repository has exported a tree, another repository can get
files from the export, after syncing.
There's a bug: While the database update works, somehow the database on
disk does not get updated, and so the database update is run the next
time, etc. Wasn't able to figure out why yet.
This commit was sponsored by Ole-Morten Duesund on Patreon.
Diffstat (limited to 'Database')
-rw-r--r-- | Database/Export.hs | 52 |
1 files changed, 28 insertions, 24 deletions
diff --git a/Database/Export.hs b/Database/Export.hs index ad106f84e..322ab48fd 100644 --- a/Database/Export.hs +++ b/Database/Export.hs @@ -15,21 +15,21 @@ module Database.Export ( openDb, closeDb, flushDbQueue, - recordDataSource, - getDataSource, addExportedLocation, removeExportedLocation, getExportedLocation, isExportDirectoryEmpty, + getExportTreeCurrent, + recordExportTreeCurrent, getExportTree, addExportTree, removeExportTree, updateExportTree, updateExportTree', ExportedId, - ExportTreeId, ExportedDirectoryId, - DataSourceId, + ExportTreeId, + ExportTreeCurrentId, ) where import Database.Types @@ -50,29 +50,33 @@ import Database.Esqueleto hiding (Key) newtype ExportHandle = ExportHandle H.DbQueue share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase| --- Files that have been exported to the remote. +-- Files that have been exported to the remote and are present on it. Exported key IKey file SFilePath ExportedIndex key file --- The tree that has been exported to the remote. --- Not all of these files are necessarily present on the remote yet. -ExportTree - key IKey - file SFilePath - ExportTreeIndex key file -- Directories that exist on the remote, and the files that are in them. ExportedDirectory subdir SFilePath file SFilePath ExportedDirectoryIndex subdir file --- Record of what tree the current database content comes from. -DataSource +-- The content of the tree that has been exported to the remote. +-- Not all of these files are necessarily present on the remote yet. +ExportTree + key IKey + file SFilePath + ExportTreeIndex key file +-- The tree stored in ExportTree +ExportTreeCurrent tree SRef UniqueTree tree |] -{- Opens the database, creating it if it doesn't exist yet. -} +{- Opens the database, creating it if it doesn't exist yet. + - + - Only a single process should write to the export at a time, so guard + - any writes with the gitAnnexExportLock. + -} openDb :: UUID -> Annex ExportHandle openDb u = do dbdir <- fromRepo (gitAnnexExportDbDir u) @@ -97,19 +101,19 @@ queueDb (ExportHandle h) = H.queueDb h checkcommit flushDbQueue :: ExportHandle -> IO () flushDbQueue (ExportHandle h) = H.flushDbQueue h -recordDataSource :: ExportHandle -> Sha -> IO () -recordDataSource h s = queueDb h $ do +recordExportTreeCurrent :: ExportHandle -> Sha -> IO () +recordExportTreeCurrent h s = queueDb h $ do delete $ from $ \r -> do - where_ (r ^. DataSourceTree ==. r ^. DataSourceTree) - void $ insertUnique $ DataSource (toSRef s) + where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree) + void $ insertUnique $ ExportTreeCurrent $ toSRef s -getDataSource :: ExportHandle -> IO (Maybe Sha) -getDataSource (ExportHandle h) = H.queryDbQueue h $ do +getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha) +getExportTreeCurrent (ExportHandle h) = H.queryDbQueue h $ do l <- select $ from $ \r -> do - where_ (r ^. DataSourceTree ==. r ^. DataSourceTree) - return (r ^. DataSourceTree) + where_ (r ^. ExportTreeCurrentTree ==. r ^. ExportTreeCurrentTree) + return (r ^. ExportTreeCurrentTree) case l of - (s:[]) -> return (Just (fromSRef (unValue s))) + (s:[]) -> return $ Just $ fromSRef $ unValue s _ -> return Nothing addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO () @@ -167,7 +171,7 @@ getExportTree (ExportHandle h) k = H.queryDbQueue h $ do addExportTree :: ExportHandle -> Key -> ExportLocation -> IO () addExportTree h k loc = queueDb h $ - void $ insertUnique $ Exported ik ef + void $ insertUnique $ ExportTree ik ef where ik = toIKey k ef = toSFilePath (fromExportLocation loc) |