4da763439b
Removed uncorrect UniqueKey key in db schema; a key can appear multiple times with different files. The database has to be flushed after each removal. But when adding files to the export, lots of changes are able to be queued up w/o flushing. So it's still fairly efficient. If large removals of files from exports are too slow, an alternative would be to make two passes over the diff, one pass queueing deletions from the database, then a flush and the a second pass updating the location log. But that would use more memory, and need to look up exportKey twice per removed file, so I've avoided such optimisation yet. This commit was supported by the NSF-funded DataLad project.
88 lines
2.5 KiB
Haskell
88 lines
2.5 KiB
Haskell
{- Sqlite database used for exports to special remotes.
|
|
-
|
|
- Copyright 2017 Joey Hess <id@joeyh.name>
|
|
-:
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
|
|
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
|
|
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module Database.Export (
|
|
ExportHandle,
|
|
openDb,
|
|
closeDb,
|
|
addExportLocation,
|
|
removeExportLocation,
|
|
flushDbQueue,
|
|
getExportLocation,
|
|
ExportedId,
|
|
) where
|
|
|
|
import Database.Types
|
|
import qualified Database.Queue as H
|
|
import Database.Init
|
|
import Annex.Locations
|
|
import Annex.Common hiding (delete)
|
|
import Types.Remote (ExportLocation(..))
|
|
|
|
import Database.Persist.TH
|
|
import Database.Esqueleto hiding (Key)
|
|
|
|
newtype ExportHandle = ExportHandle H.DbQueue
|
|
|
|
share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase|
|
|
Exported
|
|
key IKey
|
|
file SFilePath
|
|
KeyFileIndex key file
|
|
|]
|
|
|
|
{- Opens the database, creating it if it doesn't exist yet. -}
|
|
openDb :: UUID -> Annex ExportHandle
|
|
openDb u = do
|
|
dbdir <- fromRepo (gitAnnexExportDbDir u)
|
|
let db = dbdir </> "db"
|
|
unlessM (liftIO $ doesFileExist db) $ do
|
|
initDb db $ void $
|
|
runMigrationSilent migrateExport
|
|
h <- liftIO $ H.openDbQueue db "exported"
|
|
return $ ExportHandle h
|
|
|
|
closeDb :: ExportHandle -> Annex ()
|
|
closeDb (ExportHandle h) = liftIO $ H.closeDbQueue h
|
|
|
|
queueDb :: ExportHandle -> SqlPersistM () -> IO ()
|
|
queueDb (ExportHandle h) = H.queueDb h checkcommit
|
|
where
|
|
-- commit queue after 1000 changes
|
|
checkcommit sz _lastcommittime
|
|
| sz > 1000 = return True
|
|
| otherwise = return False
|
|
|
|
addExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
|
|
addExportLocation h k (ExportLocation f) = queueDb h $
|
|
void $ insertUnique $ Exported (toIKey k) (toSFilePath f)
|
|
|
|
removeExportLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
|
|
removeExportLocation h k (ExportLocation f) = queueDb h $
|
|
delete $ from $ \r -> do
|
|
where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef)
|
|
where
|
|
ik = toIKey k
|
|
ef = toSFilePath f
|
|
|
|
flushDbQueue :: ExportHandle -> IO ()
|
|
flushDbQueue (ExportHandle h) = H.flushDbQueue h
|
|
|
|
{- Note that this does not see recently queued changes. -}
|
|
getExportLocation :: ExportHandle -> Key -> IO [ExportLocation]
|
|
getExportLocation (ExportHandle h) k = H.queryDbQueue h $ do
|
|
l <- select $ from $ \r -> do
|
|
where_ (r ^. ExportedKey ==. val ik)
|
|
return (r ^. ExportedFile)
|
|
return $ map (ExportLocation . fromSFilePath . unValue) l
|
|
where
|
|
ik = toIKey k
|