summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-09-15 16:34:45 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-09-15 16:46:03 -0400
commit15d757049d764410e3d71bbb68640549f86fc543 (patch)
tree8bdff79aa30eb197142899ef82f03cc577f61862
parent2d3f18876550ee2e37a60aea1c0faaa369606ae0 (diff)
split out Types.Export
-rw-r--r--Command/Export.hs3
-rw-r--r--Database/Export.hs6
-rw-r--r--Remote/Directory.hs1
-rw-r--r--Remote/External.hs1
-rw-r--r--Remote/External/Types.hs3
-rw-r--r--Remote/Helper/Export.hs5
-rw-r--r--Remote/S3.hs1
-rw-r--r--Remote/WebDAV.hs1
-rw-r--r--Remote/WebDAV/DavLocation.hs2
-rw-r--r--Types/Export.hs31
-rw-r--r--Types/Remote.hs26
-rw-r--r--git-annex.cabal1
12 files changed, 48 insertions, 33 deletions
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 <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
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