summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs9
-rw-r--r--Command/AddUrl.hs14
-rw-r--r--Command/Fsck.hs70
-rw-r--r--Command/Get.hs38
-rw-r--r--Command/Map.hs10
-rw-r--r--Command/Move.hs8
-rw-r--r--Command/PreCommit.hs8
-rw-r--r--Command/Sync.hs30
-rw-r--r--Command/Unannex.hs8
-rw-r--r--Command/Unused.hs8
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 []
+ )
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 01:59:32 +0000