diff options
author | Joey Hess <joey@kitenet.net> | 2012-03-15 20:39:25 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-03-15 20:39:25 -0400 |
commit | c0c9991c9f5322aef05f4c97d2c3f3bdc3101e46 (patch) | |
tree | 9cdd4f7913659329283e8d909fa7c4f98cc567f0 /Remote | |
parent | ff8b6c1bab519f243b67219cc2b43d037b3fa4e2 (diff) |
nukes another 15 lines thanks to ifM
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Directory.hs | 12 | ||||
-rw-r--r-- | Remote/Git.hs | 43 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 8 | ||||
-rw-r--r-- | Remote/Hook.hs | 12 | ||||
-rw-r--r-- | Remote/Rsync.hs | 24 |
5 files changed, 45 insertions, 54 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"] |