From 269c6925ded8145aaea1f8ccdbb747f65f076131 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Sep 2017 13:15:47 -0400 Subject: implement removeExportDirectory Not yet called by Command.Export. WebDAV needs this to clean up empty collections. Also, example.sh turned out to not be cleaning up directories when removing content from them, so it made sense for it to use this. Remote.Directory did not need it, and since its cleanup method for empty directories is more efficient than what Command.Export will need to do to find empty directories, it uses Nothing so that extra work can be avoided. This commit was sponsored by Thom May on Patreon. --- Types/Remote.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'Types') diff --git a/Types/Remote.hs b/Types/Remote.hs index 272693296..798bf1af5 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -19,6 +19,7 @@ module Types.Remote , Verification(..) , unVerified , ExportLocation(..) + , ExportDirectory(..) , isExportSupported , ExportActions(..) ) @@ -164,6 +165,9 @@ unVerified a = do newtype ExportLocation = ExportLocation FilePath deriving (Show, Eq) +newtype ExportDirectory = ExportDirectory FilePath + deriving (Show, Eq) + isExportSupported :: RemoteA a -> a Bool isExportSupported r = exportSupported (remotetype r) (config r) (gitconfig r) @@ -178,6 +182,13 @@ data ExportActions a = ExportActions , retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a Bool -- Removes an exported file (succeeds if the contents are not present) , removeExport :: Key -> ExportLocation -> a Bool + -- Removes an exported directory. Typically the directory will be + -- empty, but it could possbly contain files or other directories, + -- and it's ok to delete those. If the remote does not use + -- directories, or automatically cleans up empty directories, + -- this can be Nothing. Should not fail if the directory was + -- already removed. + , removeExportDirectory :: Maybe (ExportDirectory -> a Bool) -- Checks if anything is exported to the remote at the specified -- ExportLocation. -- Throws an exception if the remote cannot be accessed. -- cgit v1.2.3