diff --git a/Command/Export.hs b/Command/Export.hs index cc463b7dcf..22ea72170b 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -20,6 +20,7 @@ import Git.FilePath import Git.Sha import Types.Key import Types.Remote +import Types.Export import Annex.Content import Annex.CatFile import Logs.Location @@ -321,6 +322,6 @@ cleanupRename ea db ek src dest = do removeExportLocation db (asKey ek) src addExportLocation db (asKey ek) dest flushDbQueue db - if exportedDirectories src /= exportedDirectories dest + if exportDirectories src /= exportDirectories dest then removeEmptyDirectories ea db src [asKey ek] else return True diff --git a/Database/Export.hs b/Database/Export.hs index cfd3f77459..df3d923000 100644 --- a/Database/Export.hs +++ b/Database/Export.hs @@ -28,7 +28,7 @@ import qualified Database.Queue as H import Database.Init import Annex.Locations import Annex.Common hiding (delete) -import Types.Remote (ExportLocation(..), ExportDirectory(..), exportedDirectories) +import Types.Export import Database.Persist.TH import Database.Esqueleto hiding (Key) @@ -73,7 +73,7 @@ addExportLocation h k el@(ExportLocation f) = queueDb h $ do void $ insertUnique $ Exported ik ef insertMany_ $ map (\(ExportDirectory d) -> ExportedDirectory (toSFilePath d) ef) - (exportedDirectories el) + (exportDirectories el) where ik = toIKey k ef = toSFilePath f @@ -83,7 +83,7 @@ removeExportLocation h k el@(ExportLocation f) = queueDb h $ do delete $ from $ \r -> do where_ (r ^. ExportedKey ==. val ik &&. r ^. ExportedFile ==. val ef) let subdirs = map (\(ExportDirectory d) -> toSFilePath d) - (exportedDirectories el) + (exportDirectories el) delete $ from $ \r -> do where_ (r ^. ExportedDirectoryFile ==. val ef &&. r ^. ExportedDirectorySubdir `in_` valList subdirs) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 24f35868b8..2d2daff39a 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -19,6 +19,7 @@ import Data.Default import Annex.Common import Types.Remote +import Types.Export import Types.Creds import qualified Git import Config.Cost diff --git a/Remote/External.hs b/Remote/External.hs index 2e40ff49a1..63f58204a8 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -11,6 +11,7 @@ import Remote.External.Types import qualified Annex import Annex.Common import Types.Remote +import Types.Export import Types.CleanupActions import Types.UrlContents import qualified Git diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 01e44b3a7e..0ddbbaf0a3 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -36,7 +36,8 @@ import Types.StandardGroups (PreferredContentExpression) import Utility.Metered (BytesProcessed(..)) import Types.Transfer (Direction(..)) import Config.Cost (Cost) -import Types.Remote (RemoteConfig, ExportLocation(..), ExportDirectory(..)) +import Types.Remote (RemoteConfig) +import Types.Export import Types.Availability (Availability(..)) import Types.Key import Utility.Url (URLString) diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs index 3067ac8377..edd0b96df0 100644 --- a/Remote/Helper/Export.hs +++ b/Remote/Helper/Export.hs @@ -12,6 +12,7 @@ module Remote.Helper.Export where import Annex.Common import Types.Remote import Types.Backend +import Types.Export import Types.Key import Backend import Remote.Helper.Encryptable (isEncrypted) @@ -152,12 +153,12 @@ adjustExportable r = case M.lookup "exporttree" (config r) of -- database. removeEmptyDirectories :: ExportActions Annex -> ExportHandle -> ExportLocation -> [Key] -> Annex Bool removeEmptyDirectories ea db loc ks - | null (exportedDirectories loc) = return True + | null (exportDirectories loc) = return True | otherwise = case removeExportDirectory ea of Nothing -> return True Just removeexportdirectory -> do ok <- allM (go removeexportdirectory) - (reverse (exportedDirectories loc)) + (reverse (exportDirectories loc)) unless ok $ liftIO $ do -- Add back to export database, so this is -- tried again next time. diff --git a/Remote/S3.hs b/Remote/S3.hs index 228a8047ed..398ca13b19 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -33,6 +33,7 @@ import System.Log.Logger import Annex.Common import Types.Remote +import Types.Export import qualified Git import Config import Config.Cost diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index ce27dd5518..921146ebd8 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -22,6 +22,7 @@ import Control.Monad.Catch import Annex.Common import Types.Remote +import Types.Export import qualified Git import Config import Config.Cost diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs index 74b4831ea7..09f2b1b477 100644 --- a/Remote/WebDAV/DavLocation.hs +++ b/Remote/WebDAV/DavLocation.hs @@ -11,7 +11,7 @@ module Remote.WebDAV.DavLocation where import Types -import Types.Remote (ExportLocation(..)) +import Types.Export import Annex.Locations import Utility.Url (URLString) #ifdef mingw32_HOST_OS diff --git a/Types/Export.hs b/Types/Export.hs new file mode 100644 index 0000000000..cc1b8debf7 --- /dev/null +++ b/Types/Export.hs @@ -0,0 +1,31 @@ +{- git-annex export types + - + - Copyright 2017 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Export where + +import qualified System.FilePath.Posix as Posix + +-- A location on a remote that a key can be exported to. +-- The FilePath will be relative to the top of the export, +-- and may contain unix-style path separators. +newtype ExportLocation = ExportLocation FilePath + deriving (Show, Eq) + +newtype ExportDirectory = ExportDirectory FilePath + deriving (Show, Eq) + +-- | All subdirectories down to the ExportLocation, with the deepest ones +-- last. Does not include the top of the export. +exportDirectories :: ExportLocation -> [ExportDirectory] +exportDirectories (ExportLocation f) = + map (ExportDirectory . Posix.joinPath . reverse) (subs [] dirs) + where + subs _ [] = [] + subs ps (d:ds) = (d:ps) : subs (d:ps) ds + + dirs = map Posix.dropTrailingPathSeparator $ + reverse $ drop 1 $ reverse $ Posix.splitPath f diff --git a/Types/Remote.hs b/Types/Remote.hs index adec329733..a734be9799 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -18,16 +18,12 @@ module Types.Remote , Availability(..) , Verification(..) , unVerified - , ExportLocation(..) - , ExportDirectory(..) , isExportSupported , ExportActions(..) - , exportedDirectories ) where import qualified Data.Map as M -import qualified System.FilePath.Posix as Posix import Data.Ord import qualified Git @@ -38,6 +34,7 @@ import Types.Availability import Types.Creds import Types.UrlContents import Types.NumCopies +import Types.Export import Config.Cost import Utility.Metered import Git.Types (RemoteName) @@ -161,15 +158,6 @@ unVerified a = do ok <- a return (ok, UnVerified) --- A location on a remote that a key can be exported to. --- The FilePath will be relative, and may contain unix-style path --- separators. -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) @@ -200,15 +188,3 @@ data ExportActions a = ExportActions -- support renames. , renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool } - --- | All subdirectories down to the ExportLocation, with the deepest ones --- last. Does not include the top of the export. -exportedDirectories :: ExportLocation -> [ExportDirectory] -exportedDirectories (ExportLocation f) = - map (ExportDirectory . Posix.joinPath . reverse) (subs [] dirs) - where - subs _ [] = [] - subs ps (d:ds) = (d:ps) : subs (d:ps) ds - - dirs = map Posix.dropTrailingPathSeparator $ - reverse $ drop 1 $ reverse $ Posix.splitPath f diff --git a/git-annex.cabal b/git-annex.cabal index 34990c1ad1..1d74b358a1 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -945,6 +945,7 @@ Executable git-annex Types.DesktopNotify Types.Difference Types.Distribution + Types.Export Types.FileMatcher Types.GitConfig Types.Group