From 15d757049d764410e3d71bbb68640549f86fc543 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 15 Sep 2017 16:34:45 -0400 Subject: split out Types.Export --- Command/Export.hs | 3 ++- Database/Export.hs | 6 +++--- Remote/Directory.hs | 1 + Remote/External.hs | 1 + Remote/External/Types.hs | 3 ++- Remote/Helper/Export.hs | 5 +++-- Remote/S3.hs | 1 + Remote/WebDAV.hs | 1 + Remote/WebDAV/DavLocation.hs | 2 +- Types/Export.hs | 31 +++++++++++++++++++++++++++++++ Types/Remote.hs | 26 +------------------------- git-annex.cabal | 1 + 12 files changed, 48 insertions(+), 33 deletions(-) create mode 100644 Types/Export.hs diff --git a/Command/Export.hs b/Command/Export.hs index cc463b7dc..22ea72170 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 cfd3f7745..df3d92300 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 24f35868b..2d2daff39 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 2e40ff49a..63f58204a 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 01e44b3a7..0ddbbaf0a 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 3067ac837..edd0b96df 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 228a8047e..398ca13b1 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 ce27dd551..921146ebd 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 74b4831ea..09f2b1b47 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 000000000..cc1b8debf --- /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 adec32973..a734be979 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 34990c1ad..1d74b358a 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 -- cgit v1.2.3