diff options
author | Joey Hess <joey@kitenet.net> | 2012-03-14 17:43:34 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-03-14 17:43:34 -0400 |
commit | 60ab3d84e188b8dd3a284d962df25bbee41ff1cb (patch) | |
tree | 768d4f632bab0152dbc1ca72f81fc3b9c7915c0a /Command | |
parent | a4f72c9625486786a4549cf4db1b542ea89da7c7 (diff) |
added ifM and nuked 11 lines of code
no behavior changes
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 9 | ||||
-rw-r--r-- | Command/AddUrl.hs | 14 | ||||
-rw-r--r-- | Command/Fsck.hs | 70 | ||||
-rw-r--r-- | Command/Get.hs | 38 | ||||
-rw-r--r-- | Command/Map.hs | 10 | ||||
-rw-r--r-- | Command/Move.hs | 8 | ||||
-rw-r--r-- | Command/PreCommit.hs | 8 | ||||
-rw-r--r-- | Command/Sync.hs | 30 | ||||
-rw-r--r-- | Command/Unannex.hs | 8 | ||||
-rw-r--r-- | Command/Unused.hs | 8 |
10 files changed, 99 insertions, 104 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index b6b5753af..ef839b2a3 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -85,8 +85,9 @@ cleanup file key hascontent = do mtime <- modificationTime <$> getFileStatus file touch file (TimeSpec mtime) False - force <- Annex.getState Annex.force - if force - then Annex.Queue.add "add" [Param "-f", Param "--"] [file] - else Annex.Queue.add "add" [Param "--"] [file] + params <- ifM (Annex.getState Annex.force) + ( return [Param "-f"] + , return [] + ) + Annex.Queue.add "add" (params++[Param "--"]) [file] return True diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 6c945baf9..c87399f5d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -51,17 +51,17 @@ perform url file = ifAnnexed file addurl geturl where geturl = do liftIO $ createDirectoryIfMissing True (parentDir file) - fast <- Annex.getState Annex.fast - if fast then nodownload url file else download url file - addurl (key, _backend) = do - ok <- liftIO $ Url.check url (keySize key) - if ok - then do + ifM (Annex.getState Annex.fast) + ( nodownload url file , download url file ) + addurl (key, _backend) = + ifM (liftIO $ Url.check url $ keySize key) + ( do setUrlPresent key url next $ return True - else do + , do warning $ "failed to verify url: " ++ url stop + ) download :: String -> FilePath -> CommandPerform download url file = do diff --git a/Command/Fsck.hs b/Command/Fsck.hs index d8d0db23b..dac3bfac9 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -62,17 +62,18 @@ perform key file backend numcopies = check {- To fsck a remote, the content is retrieved to a tmp file, - and checked locally. -} performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> CommandPerform -performRemote key file backend numcopies remote = do - v <- Remote.hasKey remote key - case v of - Left err -> do +performRemote key file backend numcopies remote = + dispatch =<< Remote.hasKey remote key + where + dispatch (Left err) = do showNote err stop - Right True -> withtmp $ \tmpfile -> do - copied <- getfile tmpfile - if copied then go True (Just tmpfile) else go True Nothing - Right False -> go False Nothing - where + dispatch (Right True) = withtmp $ \tmpfile -> + ifM (getfile tmpfile) + ( go True (Just tmpfile) + , go True Nothing + ) + dispatch (Right False) = go False Nothing go present localcopy = check [ verifyLocationLogRemote key file remote present , checkKeySizeRemote key remote localcopy @@ -87,15 +88,14 @@ performRemote key file backend numcopies remote = do let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ()) cleanup cleanup `after` a tmp - getfile tmp = do - ok <- Remote.retrieveKeyFileCheap remote key tmp - if ok - then return ok - else do - fast <- Annex.getState Annex.fast - if fast - then return False - else Remote.retrieveKeyFile remote key tmp + getfile tmp = + ifM (Remote.retrieveKeyFileCheap remote key tmp) + ( return True + , ifM (Annex.getState Annex.fast) + ( return False + , Remote.retrieveKeyFile remote key tmp + ) + ) {- To fsck a bare repository, fsck each key in the location log. -} withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek @@ -205,10 +205,10 @@ verifyLocationLog' key desc present u bad = do checkKeySize :: Key -> Annex Bool checkKeySize key = do file <- inRepo $ gitAnnexLocation key - present <- liftIO $ doesFileExist file - if present - then checkKeySize' key file badContent - else return True + ifM (liftIO $ doesFileExist file) + ( checkKeySize' key file badContent + , return True + ) checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool checkKeySizeRemote _ _ Nothing = return True @@ -219,16 +219,22 @@ checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool checkKeySize' key file bad = case Types.Key.keySize key of Nothing -> return True Just size -> do - stat <- liftIO $ getFileStatus file - let size' = fromIntegral (fileSize stat) - if size == size' - then return True - else do - msg <- bad key - warning $ "Bad file size (" ++ - compareSizes storageUnits True size size' ++ - "); " ++ msg - return False + size' <- fromIntegral . fileSize + <$> (liftIO $ getFileStatus file) + comparesizes size size' + where + comparesizes a b = do + let same = a == b + unless same $ badsize a b + return same + badsize a b = do + msg <- bad key + warning $ concat + [ "Bad file size (" + , compareSizes storageUnits True a b + , "); " + , msg + ] checkBackend :: Backend -> Key -> Annex Bool checkBackend backend key = do diff --git a/Command/Get.hs b/Command/Get.hs index 9b12b9599..772fbd90c 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -42,37 +42,29 @@ perform key = stopUnless (getViaTmp key $ getKeyFile key) $ {- Try to find a copy of the file in one of the remotes, - and copy it to here. -} getKeyFile :: Key -> FilePath -> Annex Bool -getKeyFile key file = do - remotes <- Remote.keyPossibilities key - if null remotes - then do +getKeyFile key file = dispatch =<< Remote.keyPossibilities key + where + dispatch [] = do showNote "not available" Remote.showLocations key [] return False - else trycopy remotes remotes - where + dispatch remotes = trycopy remotes remotes trycopy full [] = do Remote.showTriedRemotes full Remote.showLocations key [] return False - trycopy full (r:rs) = do - probablythere <- probablyPresent r - if probablythere - then docopy r (trycopy full rs) - else trycopy full rs + trycopy full (r:rs) = + ifM (probablyPresent r) + ( docopy r (trycopy full rs) + , trycopy full rs + ) -- This check is to avoid an ugly message if a remote is a -- drive that is not mounted. - probablyPresent r = - if Remote.hasKeyCheap r - then do - res <- Remote.hasKey r key - case res of - Right b -> return b - Left _ -> return False - else return True + probablyPresent r + | Remote.hasKeyCheap r = + either (const False) id <$> Remote.hasKey r key + | otherwise = return True docopy r continue = do showAction $ "from " ++ Remote.name r - copied <- Remote.retrieveKeyFile r key file - if copied - then return True - else continue + ifM (Remote.retrieveKeyFile r key file) + ( return True , continue) diff --git a/Command/Map.hs b/Command/Map.hs index da7a048a4..bdb86f95a 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -41,14 +41,14 @@ start = do trusted <- trustGet Trusted liftIO $ writeFile file (drawMap rs umap trusted) - next $ next $ do - fast <- Annex.getState Annex.fast - if fast - then return True - else do + next $ next $ + ifM (Annex.getState Annex.fast) + ( return True + , do showLongNote $ "running: dot -Tx11 " ++ file showOutput liftIO $ boolSystem "dot" [Param "-Tx11", File file] + ) where file = "map.dot" diff --git a/Command/Move.hs b/Command/Move.hs index 6b58f711a..8612c9f2d 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -131,13 +131,13 @@ fromOk src key return $ u /= Remote.uuid src && any (== src) remotes fromPerform :: Remote -> Bool -> Key -> CommandPerform fromPerform src move key = moveLock move key $ do - ishere <- inAnnex key - if ishere - then handle move True - else do + ifM (inAnnex key) + ( handle move True + , do showAction $ "from " ++ Remote.name src ok <- getViaTmp key $ Remote.retrieveKeyFile src key handle move ok + ) where handle _ False = stop -- failed handle False True = next $ return True -- copy complete diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index b0328ca19..06140fa52 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -7,6 +7,7 @@ module Command.PreCommit where +import Common.Annex import Command import qualified Command.Add import qualified Command.Fix @@ -26,7 +27,6 @@ start file = next $ perform file perform :: FilePath -> CommandPerform perform file = do - ok <- doCommand $ Command.Add.start file - if ok - then next $ return True - else error $ "failed to add " ++ file ++ "; canceling commit" + unlessM (doCommand $ Command.Add.start file) $ + error $ "failed to add " ++ file ++ "; canceling commit" + next $ return True diff --git a/Command/Sync.hs b/Command/Sync.hs index 51b6d6f63..b9ef0bc97 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -51,11 +51,7 @@ remoteBranch :: Remote -> Git.Ref -> Git.Ref remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote syncRemotes :: [String] -> Annex [Remote] -syncRemotes rs = do - fast <- Annex.getState Annex.fast - if fast - then nub <$> pickfast - else wanted +syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) where pickfast = (++) <$> listed <*> (good =<< fastest <$> available) wanted @@ -113,11 +109,11 @@ pullRemote remote branch = do showStart "pull" (Remote.name remote) next $ do showOutput - fetched <- inRepo $ Git.Command.runBool "fetch" + stopUnless fetch $ + next $ mergeRemote remote branch + where + fetch = inRepo $ Git.Command.runBool "fetch" [Param $ Remote.name remote] - if fetched - then next $ mergeRemote remote branch - else stop {- The remote probably has both a master and a synced/master branch. - Which to merge from? Well, the master has whatever latest changes @@ -159,15 +155,15 @@ mergeFrom branch = do changed :: Remote -> Git.Ref -> Annex Bool changed remote b = do let r = remoteBranch remote b - e <- inRepo $ Git.Ref.exists r - if e - then inRepo $ Git.Branch.changed b r - else return False + ifM (inRepo $ Git.Ref.exists r) + ( inRepo $ Git.Branch.changed b r + , return False + ) newer :: Remote -> Git.Ref -> Annex Bool newer remote b = do let r = remoteBranch remote b - e <- inRepo $ Git.Ref.exists r - if e - then inRepo $ Git.Branch.changed r b - else return True + ifM (inRepo $ Git.Ref.exists r) + ( inRepo $ Git.Branch.changed r b + , return True + ) diff --git a/Command/Unannex.hs b/Command/Unannex.hs index fee67429d..1e7313711 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -47,16 +47,16 @@ cleanup file key = do Params "-m", Param "content removed from git annex", Param "--", File file] - fast <- Annex.getState Annex.fast - if fast - then do + ifM (Annex.getState Annex.fast) + ( do -- fast mode: hard link to content in annex src <- inRepo $ gitAnnexLocation key liftIO $ do createLink src file allowWrite file - else do + , do fromAnnex key file logStatus key InfoMissing + ) return True diff --git a/Command/Unused.hs b/Command/Unused.hs index b878ab265..246929f71 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -299,11 +299,11 @@ staleKeysPrune dirspec = do staleKeys :: (Git.Repo -> FilePath) -> Annex [Key] staleKeys dirspec = do dir <- fromRepo dirspec - exists <- liftIO $ doesDirectoryExist dir - if not exists - then return [] - else do + ifM (liftIO $ doesDirectoryExist dir) + ( do contents <- liftIO $ getDirectoryContents dir files <- liftIO $ filterM doesFileExist $ map (dir </>) contents return $ mapMaybe (fileKey . takeFileName) files + , return [] + ) |