git annex move --from remote almost working

Commands.hs

@@ -367,25 +367,28 @@ moveToPerform file key = do
 	remote <- Remotes.commandLineRemote
 	isthere <- Remotes.inAnnex remote key
 	case isthere of
-		Left err -> error (show err)
-		Right False -> moveit remote key
-		Right True -> removeit remote key
-	where
-		moveit remote key = do
-			Remotes.copyToRemote remote key
-			removeit remote key
-		removeit remote key = do
-			error "TODO: drop key from local"
-			return $ Just $ moveToCleanup remote key
+		Left err -> do
+			showNote $ show err
+			return Nothing
+		Right False -> do
+			ok <- Remotes.copyToRemote remote key
+			if (ok)
+				then return $ Just $ moveToCleanup remote key
+				else return Nothing -- failed
+		Right True -> return $ Just $ moveToCleanup remote key
 moveToCleanup :: Git.Repo -> Key -> Annex Bool
 moveToCleanup remote key = do
-	-- Update local location log; key is present there and missing here.
-	logStatus key ValueMissing
-	u <- getUUID remote
-	liftIO $ logChange remote key u ValuePresent
-	-- Propigate location log to remote.
-	error "TODO: update remote locationlog"
-	return True
+	-- cleanup on the local side is the same as done for the drop subcommand
+	ok <- dropCleanup key
+	if (not ok)
+		then return False
+		else do
+			-- Record that the key is present on the remote.
+			u <- getUUID remote
+			liftIO $ logChange remote key u ValuePresent
+			-- Propigate location log to remote.
+			error "TODO: update remote locationlog"
+			return True
 
 {- Moves the content of an annexed file from another repository to the current
  - repository and updates locationlog information on both.
@@ -403,22 +406,28 @@ moveFromPerform file key = do
 	isthere <- Remotes.inAnnex remote key
 	ishere <- inAnnex key
 	case (ishere, isthere) of
-		(_, Left err) -> error (show err)
-		(_, Right False) -> return Nothing -- not in remote; fail
-		(False, Right True) -> moveit remote key
-		(True, Right True) -> removeit remote key
-	where
-		moveit remote key = do
+		(_, Left err) -> do
+			showNote $ show err
+			return Nothing
+		(_, Right False) -> do
+			showNote $ "not present in " ++ (Git.repoDescribe remote)
+			return Nothing
+		(False, Right True) -> do
+			-- copy content from remote
 			ok <- getViaTmp key (Remotes.copyFromRemote remote key)
 			if (ok)
-				then removeit remote key
+				then return $ Just $ moveFromCleanup remote key
 				else return Nothing -- fail
-		removeit remote key = do
-			error $ "TODO remove" ++ file
-			return $ Just moveFromCleanup
-moveFromCleanup :: Annex Bool
-moveFromCleanup = do
-	error "update location logs"
+		(True, Right True) -> do
+			-- the content is already here, just remove from remote
+			return $ Just $ moveFromCleanup remote key
+moveFromCleanup :: Git.Repo -> Key -> Annex Bool
+moveFromCleanup remote key = do
+	Remotes.removeRemoteFile remote $ annexLocation remote key
+	-- Record that the key is not on the remote.
+	u <- getUUID remote
+	liftIO $ logChange remote key u ValueMissing
+	Remotes.updateRemoteLogStatus remote key
 	return True
 
 -- helpers

LocationLog.hs

@@ -19,7 +19,9 @@
 module LocationLog (
 	LogStatus(..),
 	logChange,
-	keyLocations
+	keyLocations,
+	logFile,
+	readLog
 ) where
 
 import Data.Time.Clock.POSIX

Locations.hs

@@ -28,6 +28,9 @@ gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
  - <backend:fragment>
  -
  - That allows deriving the key and backend by looking at the symlink to it.
+ -
+ - Note that even if the repo is a bare repo, the annex is put in a .git
+ - sub
  -}
 annexLocation :: Git.Repo -> Key -> FilePath
 annexLocation r key = 

Remotes.hs

@@ -7,7 +7,9 @@ module Remotes (
 	inAnnex,
 	commandLineRemote,
 	copyFromRemote,
-	copyToRemote
+	copyToRemote,
+	removeRemoteFile,
+	updateRemoteLogStatus
 ) where
 
 import Control.Exception
@@ -16,8 +18,11 @@ import Control.Monad (filterM)
 import qualified Data.Map as Map
 import Data.String.Utils
 import Data.Either.Utils
+import System.Cmd.Utils
+import System.Directory
 import List
 import Maybe
+import IO (hPutStrLn)
 
 import Types
 import qualified GitRepo as Git
@@ -223,3 +228,40 @@ copyToRemote r key = do
 		location g = annexLocation g key
 		sshlocation = (Git.urlHost r) ++ ":" ++ file
 		file = error "TODO"
+
+{- Removes a file from a remote. -}
+removeRemoteFile :: Git.Repo -> FilePath -> Annex ()
+removeRemoteFile r file = do
+	if (not $ Git.repoIsUrl r)
+		then liftIO $ removeFile file
+		else if (Git.repoIsSsh r)
+			then do
+				ok <- liftIO $ boolSystem "ssh"
+					[Git.urlHost r, "rm -f " ++
+					(shellEscape file)]
+				if (ok)
+					then return ()
+					else error "failed to remove file from remote"
+			else error "removing file from non-ssh repo not supported"
+
+{- Update's a remote's location log for a key, by merging the local
+ - location log into it. -}
+updateRemoteLogStatus :: Git.Repo -> Key -> Annex ()
+updateRemoteLogStatus r key = do
+	-- To merge, just append data to the remote's
+	-- log. Since the log is timestamped, the presumably newer
+	-- information from the local will superscede the older
+	-- information in the remote's log.
+	-- TODO: remote log locking
+	let mergecmd = "cat >> " ++ (shellEscape $ logFile r key) ++ " && " ++
+		"cd " ++ (shellEscape $ Git.workTree r) ++ " && " ++
+		"git add " ++ (shellEscape $ gitStateDir r)
+	let shellcmd = if (not $ Git.repoIsUrl r)
+		then pOpen WriteToPipe "sh" ["-c", mergecmd]
+		else if (Git.repoIsSsh r)
+			then pOpen WriteToPipe "ssh" [Git.urlHost r, mergecmd]
+			else error "updating non-ssh repo not supported"
+	g <- Annex.gitRepo
+	liftIO $ shellcmd $ \h -> do
+		lines <- readLog $ logFile g key
+		hPutStrLn h $ unlines $ map show lines