simplify
This commit is contained in:
parent
1b041f5c51
commit
cdd512cd9f
3 changed files with 19 additions and 17 deletions
|
@ -17,6 +17,8 @@ import qualified Git
|
|||
import qualified Types.Remote as Remote
|
||||
import Messages
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
-- From a sha pointing to the content of a file to the key
|
||||
-- to use to export it. When the file is annexed, it's the annexed key.
|
||||
-- When the file is stored in git, it's a special type of key to indicate
|
||||
|
@ -48,6 +50,10 @@ keyGitSha k
|
|||
Just (Git.Ref (fromKey keyName k))
|
||||
| otherwise = Nothing
|
||||
|
||||
-- Is a key storing a git sha, and not used for an annexed file?
|
||||
isGitShaKey :: Key -> Bool
|
||||
isGitShaKey = isJust . keyGitSha
|
||||
|
||||
warnExportImportConflict :: Remote -> Annex ()
|
||||
warnExportImportConflict r = do
|
||||
isimport <- Remote.isImportSupported r
|
||||
|
|
|
@ -180,11 +180,10 @@ recordImportTree remote importtreeconfig importable = do
|
|||
let stillpresent db k = liftIO $ not . null
|
||||
<$> Export.getExportedLocation db k
|
||||
let updater db moldkey _newkey _ = case moldkey of
|
||||
Just oldkey -> case keyGitSha oldkey of
|
||||
Nothing -> unlessM (stillpresent db oldkey) $
|
||||
Just oldkey | not (isGitShaKey oldkey) ->
|
||||
unlessM (stillpresent db oldkey) $
|
||||
logChange oldkey (Remote.uuid remote) InfoMissing
|
||||
Just _ -> noop
|
||||
Nothing -> noop
|
||||
_ -> noop
|
||||
db <- Export.openDb (Remote.uuid remote)
|
||||
forM_ (exportedTreeishes oldexport) $ \oldtree ->
|
||||
Export.runExportDiffUpdater updater db oldtree finaltree
|
||||
|
|
|
@ -280,8 +280,8 @@ startExport r db cvar allfilledvar ti = do
|
|||
performExport :: Remote -> ExportHandle -> Key -> AssociatedFile -> Sha -> ExportLocation -> MVar AllFilled -> CommandPerform
|
||||
performExport r db ek af contentsha loc allfilledvar = do
|
||||
let storer = storeExport (exportActions r)
|
||||
sent <- tryNonAsync $ case keyGitSha ek of
|
||||
Nothing -> ifM (inAnnex ek)
|
||||
sent <- tryNonAsync $ if not (isGitShaKey ek)
|
||||
then ifM (inAnnex ek)
|
||||
( notifyTransfer Upload af $
|
||||
-- alwaysUpload because the same key
|
||||
-- could be used for more than one export
|
||||
|
@ -298,13 +298,12 @@ performExport r db ek af contentsha loc allfilledvar = do
|
|||
return False
|
||||
)
|
||||
-- Sending a non-annexed file.
|
||||
Just _ ->
|
||||
withTmpFile "export" $ \tmp h -> do
|
||||
b <- catObject contentsha
|
||||
liftIO $ L.hPut h b
|
||||
liftIO $ hClose h
|
||||
Remote.action $
|
||||
storer tmp ek loc nullMeterUpdate
|
||||
else withTmpFile "export" $ \tmp h -> do
|
||||
b <- catObject contentsha
|
||||
liftIO $ L.hPut h b
|
||||
liftIO $ hClose h
|
||||
Remote.action $
|
||||
storer tmp ek loc nullMeterUpdate
|
||||
let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
|
||||
case sent of
|
||||
Right True -> next $ cleanupExport r db ek loc True
|
||||
|
@ -318,10 +317,8 @@ performExport r db ek af contentsha loc allfilledvar = do
|
|||
cleanupExport :: Remote -> ExportHandle -> Key -> ExportLocation -> Bool -> CommandCleanup
|
||||
cleanupExport r db ek loc sent = do
|
||||
liftIO $ addExportedLocation db ek loc
|
||||
when sent $
|
||||
case keyGitSha ek of
|
||||
Nothing -> logChange ek (uuid r) InfoPresent
|
||||
Just _ -> noop
|
||||
when (sent && not (isGitShaKey ek)) $
|
||||
logChange ek (uuid r) InfoPresent
|
||||
return True
|
||||
|
||||
startUnexport :: Remote -> ExportHandle -> TopFilePath -> [Git.Sha] -> CommandStart
|
||||
|
|
Loading…
Reference in a new issue