split out Types.Export

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

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)

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

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

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)

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.

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

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

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

Types/Export.hs

@@ -0,0 +1,31 @@
+{- git-annex export types
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - 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

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

git-annex.cabal

@@ -945,6 +945,7 @@ Executable git-annex
     Types.DesktopNotify
     Types.Difference
     Types.Distribution
+    Types.Export
     Types.FileMatcher
     Types.GitConfig
     Types.Group