diff options
Diffstat (limited to 'Database/AssociatedFiles.hs')
| -rw-r--r-- | Database/AssociatedFiles.hs | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/Database/AssociatedFiles.hs b/Database/AssociatedFiles.hs index 8244f15e8..d17eb8112 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 |