summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs14
-rw-r--r--Command/EnableRemote.hs2
-rw-r--r--Command/Fsck.hs10
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/ImportFeed.hs3
-rw-r--r--Command/Indirect.hs2
-rw-r--r--Command/List.hs4
-rw-r--r--Command/Move.hs2
-rw-r--r--Command/PreCommit.hs2
-rw-r--r--Command/RecvKey.hs2
-rw-r--r--Command/Reinject.hs2
-rw-r--r--Command/SendKey.hs6
-rw-r--r--Command/Status.hs10
-rw-r--r--Command/Sync.hs34
-rw-r--r--Command/TransferInfo.hs2
-rw-r--r--Command/TransferKeys.hs2
-rw-r--r--Command/Unannex.hs2
-rw-r--r--Command/Vicfg.hs8
-rw-r--r--Command/WebApp.hs4
19 files changed, 55 insertions, 58 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 245ca2bd6..a320af63b 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -98,13 +98,13 @@ start file = ifAnnexed file addpresent add
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
-}
lockDown :: FilePath -> Annex (Maybe KeySource)
-lockDown file = ifM (crippledFileSystem)
+lockDown file = ifM crippledFileSystem
( liftIO $ catchMaybeIO nohardlink
, do
tmp <- fromRepo gitAnnexTmpDir
createAnnexDirectory tmp
- unlessM (isDirect) $ liftIO $
- void $ tryIO $ preventWrite file
+ unlessM isDirect $
+ void $ liftIO $ tryIO $ preventWrite file
liftIO $ catchMaybeIO $ do
(tmpfile, h) <- openTempFile tmp $
relatedTemplate $ takeFileName file
@@ -115,7 +115,7 @@ lockDown file = ifM (crippledFileSystem)
where
nohardlink = do
cache <- genInodeCache file
- return $ KeySource
+ return KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = cache
@@ -123,7 +123,7 @@ lockDown file = ifM (crippledFileSystem)
withhardlink tmpfile = do
createLink file tmpfile
cache <- genInodeCache tmpfile
- return $ KeySource
+ return KeySource
{ keyFilename = file
, contentLocation = tmpfile
, inodeCache = cache
@@ -134,7 +134,7 @@ lockDown file = ifM (crippledFileSystem)
- In direct mode, leaves the file alone, and just updates bookkeeping
- information.
-}
-ingest :: (Maybe KeySource) -> Annex (Maybe Key)
+ingest :: Maybe KeySource -> Annex (Maybe Key)
ingest Nothing = return Nothing
ingest (Just source) = do
backend <- chooseBackend $ keyFilename source
@@ -205,7 +205,7 @@ link file key hascontent = flip catchAnnex (undo file key) $ do
replaceFile file $ makeAnnexLink l
#ifndef __ANDROID__
- when hascontent $ do
+ when hascontent $
-- touch the symlink to have the same mtime as the
-- file it points to
liftIO $ do
diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs
index 977c80487..f6a1b819c 100644
--- a/Command/EnableRemote.hs
+++ b/Command/EnableRemote.hs
@@ -43,7 +43,7 @@ unknownNameError prefix = do
error $ prefix ++
if null names
then ""
- else " Known special remotes: " ++ intercalate " " names
+ else " Known special remotes: " ++ unwords names
perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
perform t u c = do
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 5e150f936..980a1e3cf 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -104,7 +104,7 @@ withIncremental = withValue $ do
Nothing -> noop
Just started -> do
now <- liftIO getPOSIXTime
- when (now - realToFrac started >= delta) $
+ when (now - realToFrac started >= delta)
resetStartTime
return True
@@ -187,7 +187,7 @@ performAll key backend = check
]
check :: [Annex Bool] -> Annex Bool
-check cs = all id <$> sequence cs
+check cs = and <$> sequence cs
{- Checks that the file's link points correctly to the content.
-
@@ -225,7 +225,7 @@ verifyLocationLog key desc = do
{- In direct mode, modified files will show up as not present,
- but that is expected and not something to do anything about. -}
- if (direct && not present)
+ if direct && not present
then return True
else verifyLocationLog' key desc present u (logChange key u)
@@ -345,7 +345,7 @@ checkBackend backend key mfile = go =<< isDirect
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
checkBackendRemote backend key remote = maybe (return True) go
where
- go file = checkBackendOr (badContentRemote remote) backend key file
+ go = checkBackendOr (badContentRemote remote) backend key
checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
checkBackendOr bad backend key file =
@@ -406,7 +406,7 @@ badContentDirect :: FilePath -> Key -> Annex String
badContentDirect file key = do
void $ liftIO $ catchMaybeIO $ touchFile file
logStatus key InfoMissing
- return $ "left in place for you to examine"
+ return "left in place for you to examine"
badContentRemote :: Remote -> Key -> Annex String
badContentRemote remote key = do
diff --git a/Command/Get.hs b/Command/Get.hs
index 981c2245b..9adf79393 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -75,7 +75,7 @@ getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key
( docopy r (trycopy full rs)
, trycopy full rs
)
- showlocs = Remote.showLocations key [] $
+ showlocs = Remote.showLocations key []
"No other repository is known to contain the file."
-- This check is to avoid an ugly message if a remote is a
-- drive that is not mounted.
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index e455ebb63..d2f806402 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -50,8 +50,7 @@ perform relaxed cache url = do
v <- findEnclosures url
case v of
Just l | not (null l) -> do
- ok <- all id
- <$> mapM (downloadEnclosure relaxed cache) l
+ ok <- and <$> mapM (downloadEnclosure relaxed cache) l
unless ok $
feedProblem url "problem downloading item"
next $ cleanup url True
diff --git a/Command/Indirect.hs b/Command/Indirect.hs
index f866a93b6..22c8b2d62 100644
--- a/Command/Indirect.hs
+++ b/Command/Indirect.hs
@@ -46,7 +46,7 @@ start = ifM isDirect
perform :: CommandPerform
perform = do
showStart "commit" ""
- whenM (stageDirect) $ do
+ whenM stageDirect $ do
showOutput
void $ inRepo $ Git.Command.runBool
[ Param "commit"
diff --git a/Command/List.hs b/Command/List.hs
index 1c424cddc..56ec0cd03 100644
--- a/Command/List.hs
+++ b/Command/List.hs
@@ -72,9 +72,9 @@ type RemoteName = String
type Present = Bool
header :: [(RemoteName, TrustLevel)] -> String
-header remotes = (unlines $ zipWith formatheader [0..] remotes) ++ (pipes (length remotes))
+header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
where
- formatheader n (remotename, trustlevel) = (pipes n) ++ remotename ++ (trust trustlevel)
+ formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
pipes = flip replicate '|'
trust UnTrusted = " (untrusted)"
trust _ = ""
diff --git a/Command/Move.hs b/Command/Move.hs
index ea8cd7163..dc501ae0f 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -38,7 +38,7 @@ start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> C
start to from move file (key, _) = start' to from move (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
-startKey to from move key = start' to from move Nothing key
+startKey to from move = start' to from move Nothing
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
start' to from move afile key = do
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index afc5882d4..0943c0da7 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -24,7 +24,7 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing
seek :: [CommandSeek]
seek =
-- fix symlinks to files being committed
- [ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed $ Command.Fix.start
+ [ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
-- inject unlocked files into the annex
, whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect
-- update direct mode mappings for committed files
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index c316e2ca5..eb2c88ca9 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -32,7 +32,7 @@ seek = [withKeys start]
start :: Key -> CommandStart
start key = ifM (inAnnex key)
( error "key is already present in annex"
- , fieldTransfer Download key $ \_p -> do
+ , fieldTransfer Download key $ \_p ->
ifM (getViaTmp key go)
( do
-- forcibly quit after receiving one key,
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 642f38947..e4abeef3c 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -34,7 +34,7 @@ start (src:dest:[])
start _ = error "specify a src file and a dest file"
perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
-perform src _dest (key, backend) = do
+perform src _dest (key, backend) =
{- Check the content before accepting it. -}
ifM (Command.Fsck.checkKeySizeOr reject key src
<&&> Command.Fsck.checkBackendOr reject backend key src)
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index afd1ac1e0..039a3d7ca 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -46,6 +46,6 @@ fieldTransfer direction key a = do
ok <- maybe (a $ const noop)
(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
=<< Fields.getField Fields.remoteUUID
- if ok
- then liftIO exitSuccess
- else liftIO exitFailure
+ liftIO $ if ok
+ then exitSuccess
+ else exitFailure
diff --git a/Command/Status.hs b/Command/Status.hs
index 8872747fb..8e41a96a9 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -238,10 +238,10 @@ transfer_list :: Stat
transfer_list = stat "transfers in progress" $ nojson $ lift $ do
uuidmap <- Remote.remoteMap id
ts <- getTransfers
- if null ts
- then return "none"
- else return $ multiLine $
- map (\(t, i) -> line uuidmap t i) $ sort ts
+ return $ if null ts
+ then "none"
+ else multiLine $
+ map (uncurry $ line uuidmap) $ sort ts
where
line uuidmap t i = unwords
[ showLcDirection (transferDirection t) ++ "ing"
@@ -340,7 +340,7 @@ emptyKeyData :: KeyData
emptyKeyData = KeyData 0 0 0 M.empty
emptyNumCopiesStats :: NumCopiesStats
-emptyNumCopiesStats = NumCopiesStats $ M.empty
+emptyNumCopiesStats = NumCopiesStats M.empty
foldKeys :: [Key] -> KeyData
foldKeys = foldl' (flip addKey) emptyKeyData
diff --git a/Command/Sync.hs b/Command/Sync.hs
index d8c6fb8d4..8b32e550f 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -86,20 +86,19 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
fastest = fromMaybe [] . headMaybe . Remote.byCost
commit :: CommandStart
-commit = next $ next $ do
- ifM isDirect
- ( do
- void $ stageDirect
- runcommit []
- , runcommit [Param "-a"]
- )
+commit = next $ next $ ifM isDirect
+ ( do
+ void stageDirect
+ runcommit []
+ , runcommit [Param "-a"]
+ )
where
runcommit ps = do
showStart "commit" ""
showOutput
Annex.Branch.commit "update"
-- Commit will fail when the tree is clean, so ignore failure.
- let params = (Param "commit") : ps ++
+ let params = Param "commit" : ps ++
[Param "-m", Param "git-annex automatic sync"]
_ <- inRepo $ tryIO . Git.Command.runQuiet params
return True
@@ -151,12 +150,12 @@ pullRemote remote branch = do
- were committed (or pushed changes, if this is a bare remote),
- while the synced/master may have changes that some
- other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> (Maybe Git.Ref) -> CommandCleanup
+mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
mergeRemote remote b = case b of
Nothing -> do
branch <- inRepo Git.Branch.currentUnsafe
- all id <$> (mapM merge $ branchlist branch)
- Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b))
+ and <$> mapM merge (branchlist branch)
+ Just _ -> and <$> (mapM merge =<< tomerge (branchlist b))
where
merge = mergeFrom . remoteBranch remote
tomerge branches = filterM (changed remote) branches
@@ -221,7 +220,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
mergeAnnex :: CommandStart
mergeAnnex = do
- void $ Annex.Branch.forceUpdate
+ void Annex.Branch.forceUpdate
stop
{- Merges from a branch into the current branch. -}
@@ -244,7 +243,7 @@ mergeFrom branch = do
mergeDirectCleanup d oldsha newsha
_ -> noop
return r
- runmerge a = ifM (a)
+ runmerge a = ifM a
( return True
, resolveMerge
)
@@ -268,7 +267,7 @@ resolveMerge :: Annex Bool
resolveMerge = do
top <- fromRepo Git.repoPath
(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
- merged <- all id <$> mapM resolveMerge' fs
+ merged <- and <$> mapM resolveMerge' fs
void $ liftIO cleanup
(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])
@@ -291,7 +290,7 @@ resolveMerge' u
withKey LsFiles.valUs $ \keyUs ->
withKey LsFiles.valThem $ \keyThem -> do
ifM isDirect
- ( maybe noop (\k -> removeDirect k file) keyUs
+ ( maybe noop (`removeDirect` file) keyUs
, liftIO $ nukeFile file
)
Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
@@ -307,14 +306,13 @@ resolveMerge' u
makelink keyThem
return True
file = LsFiles.unmergedFile u
- issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
- [Just SymlinkBlob, Nothing]
+ issymlink select = select (LsFiles.unmergedBlobType u) `elem` [Just SymlinkBlob, Nothing]
makelink (Just key) = do
let dest = mergeFile file key
l <- inRepo $ gitAnnexLink dest key
replaceFile dest $ makeAnnexLink l
stageSymlink dest =<< hashSymlink l
- whenM (isDirect) $
+ whenM isDirect $
toDirect key dest
makelink _ = noop
withKey select a = do
diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs
index 4bebdebcd..93f6c7077 100644
--- a/Command/TransferInfo.hs
+++ b/Command/TransferInfo.hs
@@ -36,7 +36,7 @@ seek = [withWords start]
-}
start :: [String] -> CommandStart
start (k:[]) = do
- case (file2key k) of
+ case file2key k of
Nothing -> error "bad key"
(Just key) -> whenM (inAnnex key) $ do
file <- Fields.getField Fields.associatedFile
diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs
index 8da29e211..5ac9454aa 100644
--- a/Command/TransferKeys.hs
+++ b/Command/TransferKeys.hs
@@ -41,7 +41,7 @@ seek = [withField readFdOption convertFd $ \readh ->
convertFd :: Maybe String -> Annex (Maybe Handle)
convertFd Nothing = return Nothing
-convertFd (Just s) = liftIO $ do
+convertFd (Just s) = liftIO $
case readish s of
Nothing -> error "bad fd"
Just fd -> Just <$> fdToHandle fd
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index fbeaffa52..66665f494 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -46,7 +46,7 @@ performIndirect file key = do
-- git as a normal non-annexed file, to thinking that the
-- file has been unlocked and needs to be re-annexed.
(s, reap) <- inRepo $ LsFiles.staged [file]
- when (not $ null s) $
+ unless (null s) $
inRepo $ Git.Command.run
[ Param "commit"
, Param "-q"
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 1aa8722c5..dfdcde134 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -123,14 +123,14 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
settings field desc showvals showdefaults = concat
[ desc
, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
- , concatMap (\u -> lcom $ showdefaults u) $ missing field
+ , concatMap (lcom . showdefaults) $ missing field
]
line setting u value =
- [ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")"
+ [ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
, unwords [setting, fromUUID u, "=", value]
]
- lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l)
+ lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
{- If there's a parse error, returns a new version of the file,
@@ -139,7 +139,7 @@ parseCfg :: Cfg -> String -> Either String Cfg
parseCfg curcfg = go [] curcfg . lines
where
go c cfg []
- | null (catMaybes $ map fst c) = Right cfg
+ | null (mapMaybe fst c) = Right cfg
| otherwise = Left $ unlines $
badheader ++ concatMap showerr (reverse c)
go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index eeb23a164..6577ce02b 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -55,7 +55,7 @@ start = start' True
start' :: Bool -> Maybe HostName -> CommandStart
start' allowauto listenhost = do
- liftIO $ ensureInstalled
+ liftIO ensureInstalled
ifM isInitialized ( go , auto )
stop
where
@@ -209,7 +209,7 @@ openBrowser mcmd htmlshim realurl outh errh = do
, std_err = maybe Inherit UseHandle errh
}
exitcode <- waitForProcess pid
- unless (exitcode == ExitSuccess) $ do
+ unless (exitcode == ExitSuccess) $
hPutStrLn (fromMaybe stderr errh) "failed to start web browser"
{- web.browser is a generic git config setting for a web browser program -}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 21:57:45 +0000