diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Directory.hs | 6 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 8 | ||||
| -rw-r--r-- | Remote/Helper/Export.hs | 12 | ||||
| -rw-r--r-- | Remote/S3.hs | 2 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 4 | ||||
| -rw-r--r-- | Remote/WebDAV/DavLocation.hs | 2 |
6 files changed, 17 insertions, 17 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 2d2daff39..406af0fdc 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -274,14 +274,14 @@ renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do dest = exportPath d newloc exportPath :: FilePath -> ExportLocation -> FilePath -exportPath d (ExportLocation loc) = d </> loc +exportPath d loc = d </> fromExportLocation loc {- Removes the ExportLocation directory and its parents, so long as - they're empty, up to but not including the topdir. -} removeExportLocation :: FilePath -> ExportLocation -> IO () -removeExportLocation topdir (ExportLocation loc) = go (Just loc) (Right ()) +removeExportLocation topdir loc = go (Just $ fromExportLocation loc) (Right ()) where go _ (Left _e) = return () go Nothing _ = return () go (Just loc') _ = go (upFrom loc') - =<< tryIO (removeDirectory $ exportPath topdir (ExportLocation loc')) + =<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc')) diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 0ddbbaf0a..77f3e837e 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -358,9 +358,9 @@ instance Proto.Serializable URI where deserialize = parseURI instance Proto.Serializable ExportLocation where - serialize (ExportLocation loc) = loc - deserialize = Just . ExportLocation + serialize = fromExportLocation + deserialize = Just . mkExportLocation instance Proto.Serializable ExportDirectory where - serialize (ExportDirectory loc) = loc - deserialize = Just . ExportDirectory + serialize = fromExportDirectory + deserialize = Just . mkExportDirectory diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs index df75dacd0..6f4811285 100644 --- a/Remote/Helper/Export.hs +++ b/Remote/Helper/Export.hs @@ -93,7 +93,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of -- Storing a key on an export would need a way to -- look up the file(s) that the currently exported -- tree uses for a key; there's not currently an - -- inexpensive way to do that (getExportLocation + -- inexpensive way to do that (getExportedLocation -- only finds files that have been stored on the -- export already). { storeKey = \_ _ _ -> do @@ -105,7 +105,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of , retrieveKeyFile = \k _af dest p -> unVerified $ if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k)) then do - locs <- liftIO $ getExportLocation db k + locs <- liftIO $ getExportedLocation db k case locs of [] -> do warning "unknown export location" @@ -136,7 +136,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of , checkPresent = \k -> do ea <- exportActions r anyM (checkPresentExport ea k) - =<< liftIO (getExportLocation db k) + =<< liftIO (getExportedLocation db k) , mkUnavailable = return Nothing , getInfo = do is <- getInfo r @@ -155,10 +155,10 @@ removeEmptyDirectories ea db loc ks ok <- allM (go removeexportdirectory) (reverse (exportDirectories loc)) unless ok $ liftIO $ do - -- Add back to export database, so this is - -- tried again next time. + -- Add location back to export database, + -- so this is tried again next time. forM_ ks $ \k -> - addExportLocation db k loc + addExportedLocation db k loc flushDbQueue db return ok where diff --git a/Remote/S3.hs b/Remote/S3.hs index 398ca13b1..52d03ba94 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -615,7 +615,7 @@ getBucketObject c = munge . key2file _ -> getFilePrefix c ++ s getBucketExportLocation :: RemoteConfig -> ExportLocation -> FilePath -getBucketExportLocation c (ExportLocation loc) = getFilePrefix c ++ loc +getBucketExportLocation c loc = getFilePrefix c ++ fromExportLocation loc {- Internet Archive documentation limits filenames to a subset of ascii. - While other characters seem to work now, this entity encodes everything diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 921146ebd..495b3f8fc 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -204,8 +204,8 @@ removeExportDav mh _k loc = runExport mh $ \_dav -> removeHelper (exportLocation loc) removeExportDirectoryDav :: Maybe DavHandle -> ExportDirectory -> Annex Bool -removeExportDirectoryDav mh (ExportDirectory dir) = runExport mh $ \_dav -> - safely (inLocation dir delContentM) +removeExportDirectoryDav mh dir = runExport mh $ \_dav -> + safely (inLocation (fromExportDirectory dir) delContentM) >>= maybe (return False) (const $ return True) renameExportDav :: Maybe DavHandle -> Key -> ExportLocation -> ExportLocation -> Annex Bool diff --git a/Remote/WebDAV/DavLocation.hs b/Remote/WebDAV/DavLocation.hs index 09f2b1b47..cbe87e6a7 100644 --- a/Remote/WebDAV/DavLocation.hs +++ b/Remote/WebDAV/DavLocation.hs @@ -47,7 +47,7 @@ keyLocation :: Key -> DavLocation keyLocation k = keyDir k ++ keyFile k exportLocation :: ExportLocation -> DavLocation -exportLocation (ExportLocation f) = f +exportLocation = fromExportLocation {- Where we store temporary data for a key as it's being uploaded. -} keyTmpLocation :: Key -> DavLocation |