directory CoW on export

Completing Cow support for directory.

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index aa5b8a61d8ba608b79fcb995a2148663aee0c3c1..195fad0759a8cb744f0860cca885d832a5dbcb4b 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -87,7 +87,7 @@ gen r u rc gc rs = do
                        , checkPresent = checkPresentDummy
                        , checkPresentCheap = True
                        , exportActions = ExportActions
-                               { storeExport = storeExportM dir
+                               { storeExport = storeExportM dir cow
                                , retrieveExport = retrieveExportM dir cow
                                , removeExport = removeExportM dir
                                , versionedExport = False
@@ -101,7 +101,7 @@ gen r u rc gc rs = do
                                { listImportableContents = listImportableContentsM dir
                                , importKey = Just (importKeyM dir)
                                , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM dir cow
-                               , storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir
+                               , storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir cow
                                , removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir
                                -- Not needed because removeExportWithContentIdentifier
                                -- auto-removes empty directories.
@@ -303,15 +303,15 @@ checkPresentGeneric' d check = ifM check
                )
        )
 
-storeExportM :: RawFilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
-storeExportM d src _k loc p = liftIO $ do
-       createDirectoryUnder d (P.takeDirectory dest)
+storeExportM :: RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
+storeExportM d cow src k loc p = do
+       liftIO $ createDirectoryUnder d (P.takeDirectory dest)
        -- Write via temp file so that checkPresentGeneric will not
        -- see it until it's fully stored.
        viaTmp go (fromRawFilePath dest) ()
   where
        dest = exportPath d loc
-       go tmp () = withMeteredFile src p (L.writeFile tmp)
+       go tmp () = fileCopierUnVerified cow src tmp k p
 
 retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()
 retrieveExportM d cow k loc dest p = fileCopierUnVerified cow src dest k p
@@ -491,14 +491,12 @@ retrieveExportWithContentIdentifierM dir cow loc cid dest mkkey p =
                        =<< R.getFileStatus f
                guardSameContentIdentifiers cont cid currcid
 
-storeExportWithContentIdentifierM :: RawFilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
-storeExportWithContentIdentifierM dir src _k loc overwritablecids p = do
+storeExportWithContentIdentifierM :: RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
+storeExportWithContentIdentifierM dir cow src k loc overwritablecids p = do
        liftIO $ createDirectoryUnder dir (toRawFilePath destdir)
-       withTmpFileIn destdir template $ \tmpf tmph -> do
+       withTmpFileIn destdir template $ \tmpf _tmph -> do
+               fileCopierUnVerified cow src tmpf k p
                let tmpf' = toRawFilePath tmpf
-               liftIO $ withMeteredFile src p (L.hPut tmph)
-               liftIO $ hFlush tmph
-               liftIO $ hClose tmph
                resetAnnexFilePerm tmpf'
                liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf' >>= \case
                        Nothing -> giveup "unable to generate content identifier"

diff --git a/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___.mdwn b/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___.mdwn
index 18b6128a6b8531f3156f4ba0b54cf6121a3e0598..2a0d724bde9709519cbbdd9b0f1294fda7d1c3bc 100644 (file)
--- a/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___.mdwn
+++ b/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___.mdwn
@@ -18,3 +18,4 @@ Joey, is it expected to take advantage of CoW with git-annex 8.20210223-1~ndall+
 [[!meta author=yoh]]
 [[!tag projects/datalad]]
 
+> [[fixed|done]] --[[Joey]]

diff --git a/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___/comment_4_fca845bb9869e8ce9a279952813ce481._comment b/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___/comment_4_fca845bb9869e8ce9a279952813ce481._comment
index 1b3048389177939455d43bbab086083ad925b826..6328271bf5412ea75d2fdd99d58fc92c41b48041 100644 (file)
--- a/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___/comment_4_fca845bb9869e8ce9a279952813ce481._comment
+++ b/doc/todo/import_from_directory_does_not_use_cp_--reflink__63___/comment_4_fca845bb9869e8ce9a279952813ce481._comment
@@ -4,7 +4,4 @@
  date="2021-04-14T19:33:13Z"
  content="""
 Implemented CoW for directory special remote, comprehensively.
-
-(Except for when exporting to it, which I'll do for completeness before closing
-this.)
 """]]