summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Remote/Directory.hs12
-rw-r--r--Remote/Git.hs43
-rw-r--r--Remote/Helper/Hooks.hs8
-rw-r--r--Remote/Hook.hs12
-rw-r--r--Remote/Rsync.hs24
-rw-r--r--Utility/Url.hs32
6 files changed, 57 insertions, 74 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 80c45a691..ecbf511d6 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -100,11 +100,7 @@ withCheckedFiles _ _ [] _ _ = return False
withCheckedFiles check Nothing d k a = go $ locations d k
where
go [] = return False
- go (f:fs) = do
- use <- check f
- if use
- then a [f]
- else go fs
+ go (f:fs) = ifM (check f) ( a [f] , go fs )
withCheckedFiles check (Just _) d k a = go $ locations d k
where
go [] = return False
@@ -115,10 +111,8 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
then do
count <- readcount chunkcount
let chunks = take count $ chunkStream f
- ok <- all id <$> mapM check chunks
- if ok
- then a chunks
- else return False
+ ifM (all id <$> mapM check chunks)
+ ( a chunks , return False )
else go fs
readcount f = fromMaybe (error $ "cannot parse " ++ f)
. (readish :: String -> Maybe Int)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 12a7f1844..5c10c0fc9 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -127,10 +127,11 @@ tryGitConfigRead r
Annex.changeState $ \s -> s { Annex.repo = g' }
exchange [] _ = []
- exchange (old:ls) new =
- if Git.remoteName old == Git.remoteName new
- then new : exchange ls new
- else old : exchange ls new
+ exchange (old:ls) new
+ | Git.remoteName old == Git.remoteName new =
+ new : exchange ls new
+ | otherwise =
+ old : exchange ls new
{- Checks if a given remote has the content for a key inAnnex.
- If the remote cannot be accessed, or if it cannot determine
@@ -227,11 +228,11 @@ copyFromRemoteCheap r key file
| not $ Git.repoIsUrl r = do
loc <- liftIO $ gitAnnexLocation key r
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
- | Git.repoIsSsh r = do
- ok <- Annex.Content.preseedTmp key file
- if ok
- then copyFromRemote r key file
- else return False
+ | Git.repoIsSsh r =
+ ifM (Annex.Content.preseedTmp key file)
+ ( copyFromRemote r key file
+ , return False
+ )
| otherwise = return False
{- Tries to copy a key's content to a remote's annex. -}
@@ -254,22 +255,24 @@ copyToRemote r key
rsyncHelper :: [CommandParam] -> Annex Bool
rsyncHelper p = do
showOutput -- make way for progress bar
- res <- liftIO $ rsync p
- if res
- then return res
- else do
+ ifM (liftIO $ rsync p)
+ ( return True
+ , do
showLongNote "rsync failed -- run git annex again to resume file transfer"
- return res
+ return False
+ )
{- Copys a file with rsync unless both locations are on the same
- filesystem. Then cp could be faster. -}
rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> Annex Bool
-rsyncOrCopyFile rsyncparams src dest = do
- ss <- liftIO $ getFileStatus $ parentDir src
- ds <- liftIO $ getFileStatus $ parentDir dest
- if deviceID ss == deviceID ds
- then liftIO $ copyFileExternal src dest
- else rsyncHelper $ rsyncparams ++ [Param src, Param dest]
+rsyncOrCopyFile rsyncparams src dest =
+ ifM (sameDeviceIds src dest)
+ ( liftIO $ copyFileExternal src dest
+ , rsyncHelper $ rsyncparams ++ [Param src, Param dest]
+ )
+ where
+ sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
+ getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 5929b1793..ed329b914 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -84,10 +84,8 @@ runHooks r starthook stophook a = do
liftIO $ closeFd fd
lookupHook :: Remote -> String -> Annex (Maybe String)
-lookupHook r n = do
- command <- getConfig (repo r) hookname ""
- if null command
- then return Nothing
- else return $ Just command
+lookupHook r n = go =<< getConfig (repo r) hookname ""
where
+ go "" = return Nothing
+ go command = return $ Just command
hookname = n ++ "-command"
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index b37d5e215..1e5c27b91 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -89,13 +89,13 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
where
run command = do
showOutput -- make way for hook output
- res <- liftIO $ boolSystemEnv
- "sh" [Param "-c", Param command] $ hookEnv k f
- if res
- then a
- else do
+ ifM (liftIO $ boolSystemEnv
+ "sh" [Param "-c", Param command] $ hookEnv k f)
+ ( a
+ , do
warning $ hook ++ " hook exited nonzero!"
- return res
+ return False
+ )
store :: String -> Key -> Annex Bool
store h k = do
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 577ea0b04..03c9911d7 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -113,20 +113,16 @@ retrieve o k f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o
]
retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieveCheap o k f = do
- ok <- preseedTmp k f
- if ok
- then retrieve o k f
- else return False
+retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k f , return False )
retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> do
- res <- retrieve o enck tmp
- if res
- then liftIO $ catchBoolIO $ do
+ ifM (retrieve o enck tmp)
+ ( liftIO $ catchBoolIO $ do
withDecryptedContent cipher (L.readFile tmp) $ L.writeFile f
return True
- else return res
+ , return False
+ )
remove :: RsyncOpts -> Key -> Annex Bool
remove o k = withRsyncScratchDir $ \tmp -> liftIO $ do
@@ -188,12 +184,12 @@ withRsyncScratchDir a = do
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
rsyncRemote o params = do
showOutput -- make way for progress bar
- res <- liftIO $ rsync $ rsyncOptions o ++ defaultParams ++ params
- if res
- then return res
- else do
+ ifM (liftIO $ rsync $ rsyncOptions o ++ defaultParams ++ params)
+ ( return True
+ , do
showLongNote "rsync failed -- run git annex again to resume file transfer"
- return res
+ return False
+ )
where
defaultParams = [Params "--progress"]
diff --git a/Utility/Url.hs b/Utility/Url.hs
index 8a43cf788..8a8d732a3 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -14,15 +14,10 @@ module Utility.Url (
get
) where
-import Control.Applicative
-import Control.Monad
+import Common
import qualified Network.Browser as Browser
import Network.HTTP
import Network.URI
-import Data.Maybe
-
-import Utility.SafeCommand
-import Utility.Path
type URLString = String
@@ -47,7 +42,7 @@ exists url =
(2,_,_) -> return (True, size r)
_ -> return (False, Nothing)
where
- size = liftM read . lookupHeader HdrContentLength . rspHeaders
+ size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
canDownload :: IO Bool
canDownload = (||) <$> inPath "wget" <*> inPath "curl"
@@ -60,20 +55,17 @@ canDownload = (||) <$> inPath "wget" <*> inPath "curl"
- for only one in.
-}
download :: URLString -> [CommandParam] -> FilePath -> IO Bool
-download url options file = do
- e <- inPath "wget"
- if e
- then
- go "wget" [Params "-c -O", File file, File url]
- else
- -- Uses the -# progress display, because the normal
- -- one is very confusing when resuming, showing
- -- the remainder to download as the whole file,
- -- and not indicating how much percent was
- -- downloaded before the resume.
- go "curl" [Params "-L -C - -# -o", File file, File url]
+download url options file = ifM (inPath "wget") (wget , curl)
where
- go cmd opts = boolSystem cmd (options++opts)
+ wget = go "wget" [Params "-c -O"]
+ {- Uses the -# progress display, because the normal
+ - one is very confusing when resuming, showing
+ - the remainder to download as the whole file,
+ - and not indicating how much percent was
+ - downloaded before the resume. -}
+ curl = go "curl" [Params "-L -C - -# -o"]
+ go cmd opts = boolSystem cmd $
+ options++opts++[File file, File url]
{- Downloads a small file. -}
get :: URLString -> IO String
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-17 15:01:25 +0000