diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-09-04 13:52:22 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-09-04 13:53:08 -0400 |
commit | a60c23a82991738882aab1946206215c0758a34d (patch) | |
tree | 5de67d6003b265959db2b81194543cff802e5359 /Database | |
parent | 5ce97e8c736c121d53af23d7036264868a461db8 (diff) |
track exported files in a sqlite database
Went with a separate db per export remote, rather than a single export
database. Mostly because there will probably not be a lot of separate
export remotes, and it might be convenient to be able to delete a given
remote's export database.
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Database')
-rw-r--r-- | Database/Export.hs | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/Database/Export.hs b/Database/Export.hs new file mode 100644 index 000000000..bc79af29f --- /dev/null +++ b/Database/Export.hs @@ -0,0 +1,85 @@ +{- 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, + 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) + +data ExportHandle = ExportHandle H.DbQueue + +share [mkPersist sqlSettings, mkMigrate "migrateExport"] [persistLowerCase| +Exported + key IKey + file SFilePath + KeyFileIndex key file + UniqueKey key +|] + +{- 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 + +{- Doesn't know about 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 |