incomplete
This commit is contained in:
parent
f05ed818f9
commit
3cf16c9883
2 changed files with 36 additions and 17 deletions
11
Commands.hs
11
Commands.hs
|
@ -308,12 +308,13 @@ moveTo file = isAnnexed file $ \(key, backend) -> do
|
||||||
isthere <- Remotes.inAnnex remote key
|
isthere <- Remotes.inAnnex remote key
|
||||||
case isthere of
|
case isthere of
|
||||||
Left err -> error (show err)
|
Left err -> error (show err)
|
||||||
Right True -> removeit
|
Right False -> moveit remote key
|
||||||
Right False -> moveit
|
Right True -> removeit remote key
|
||||||
where
|
where
|
||||||
moveit = do
|
moveit remote key = do
|
||||||
error $ "TODO move" ++ file
|
Remotes.copyToRemote remote key
|
||||||
removeit = do
|
removeit remote key
|
||||||
|
removeit remote key = do
|
||||||
error $ "TODO remove" ++ file
|
error $ "TODO remove" ++ file
|
||||||
|
|
||||||
{- Moves the content of an annexed file from another repository to the current
|
{- Moves the content of an annexed file from another repository to the current
|
||||||
|
|
42
Remotes.hs
42
Remotes.hs
|
@ -6,7 +6,8 @@ module Remotes (
|
||||||
tryGitConfigRead,
|
tryGitConfigRead,
|
||||||
inAnnex,
|
inAnnex,
|
||||||
commandLineRemote,
|
commandLineRemote,
|
||||||
copyFromRemote
|
copyFromRemote,
|
||||||
|
copyToRemote
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
@ -70,13 +71,11 @@ keyPossibilities key = do
|
||||||
return $ null u
|
return $ null u
|
||||||
|
|
||||||
{- Checks if a given remote has the content for a key inAnnex.
|
{- Checks if a given remote has the content for a key inAnnex.
|
||||||
-
|
|
||||||
- This is done by constructing a new Annex monad using the remote.
|
|
||||||
-
|
|
||||||
- If the remote cannot be accessed, returns a Left error.
|
- If the remote cannot be accessed, returns a Left error.
|
||||||
-}
|
-}
|
||||||
inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
|
inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
|
||||||
inAnnex remote key = do
|
inAnnex remote key = do
|
||||||
|
-- the check needs to run in an Annex monad using the remote
|
||||||
a <- liftIO $ Annex.new remote []
|
a <- liftIO $ Annex.new remote []
|
||||||
liftIO $ ((try $ check a)::IO (Either IOException Bool))
|
liftIO $ ((try $ check a)::IO (Either IOException Bool))
|
||||||
where
|
where
|
||||||
|
@ -181,7 +180,7 @@ tryGitConfigRead r = do
|
||||||
then new:(exchange ls new)
|
then new:(exchange ls new)
|
||||||
else old:(exchange ls new)
|
else old:(exchange ls new)
|
||||||
|
|
||||||
{- Tries to copy a file from a remote. -}
|
{- Tries to copy a key's content from a remote to a file. -}
|
||||||
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
|
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
|
||||||
copyFromRemote r key file = do
|
copyFromRemote r key file = do
|
||||||
-- annexLocation needs the git config to have been read for a remote,
|
-- annexLocation needs the git config to have been read for a remote,
|
||||||
|
@ -189,13 +188,13 @@ copyFromRemote r key file = do
|
||||||
result <- tryGitConfigRead r
|
result <- tryGitConfigRead r
|
||||||
case (result) of
|
case (result) of
|
||||||
Left err -> return False
|
Left err -> return False
|
||||||
Right r' -> copy r'
|
Right from -> copy from
|
||||||
where
|
where
|
||||||
copy r = do
|
copy from = do
|
||||||
Core.showNote $ "copying from " ++ (Git.repoDescribe r) ++ "..."
|
Core.showNote $ "copying from " ++ (Git.repoDescribe from) ++ "..."
|
||||||
if (not $ Git.repoIsUrl r)
|
if (not $ Git.repoIsUrl from)
|
||||||
then getlocal
|
then getlocal
|
||||||
else if (Git.repoIsSsh r)
|
else if (Git.repoIsSsh from)
|
||||||
then getssh
|
then getssh
|
||||||
else error "copying from non-ssh repo not supported"
|
else error "copying from non-ssh repo not supported"
|
||||||
where
|
where
|
||||||
|
@ -203,5 +202,24 @@ copyFromRemote r key file = do
|
||||||
getssh = do
|
getssh = do
|
||||||
liftIO $ putStrLn "" -- make way for scp progress bar
|
liftIO $ putStrLn "" -- make way for scp progress bar
|
||||||
liftIO $ boolSystem "scp" [sshlocation, file]
|
liftIO $ boolSystem "scp" [sshlocation, file]
|
||||||
location = annexLocation r key
|
location = annexLocation from key
|
||||||
sshlocation = (Git.urlHost r) ++ ":" ++ location
|
sshlocation = (Git.urlHost from) ++ ":" ++ location
|
||||||
|
|
||||||
|
{- Tries to copy a key's content to a remote. -}
|
||||||
|
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
||||||
|
copyToRemote r key = do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
Core.showNote $ "copying to " ++ (Git.repoDescribe r) ++ "..."
|
||||||
|
if (not $ Git.repoIsUrl r)
|
||||||
|
then sendlocal g
|
||||||
|
else if (Git.repoIsSsh r)
|
||||||
|
then sendssh g
|
||||||
|
else error "copying to non-ssh repo not supported"
|
||||||
|
where
|
||||||
|
sendlocal g = liftIO $ boolSystem "cp" ["-a", location g, file]
|
||||||
|
sendssh g = do
|
||||||
|
liftIO $ putStrLn "" -- make way for scp progress bar
|
||||||
|
liftIO $ boolSystem "scp" [location g, sshlocation]
|
||||||
|
location g = annexLocation g key
|
||||||
|
sshlocation = (Git.urlHost r) ++ ":" ++ file
|
||||||
|
file = error "TODO"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue