summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Backend.hs2
-rw-r--r--Backend/File.hs78
-rw-r--r--Backend/SHA1.hs10
-rw-r--r--Backend/WORM.hs10
-rw-r--r--Command/Add.hs4
-rw-r--r--Command/Drop.hs6
-rw-r--r--Command/DropKey.hs6
-rw-r--r--Command/Find.hs2
-rw-r--r--Command/Fix.hs2
-rw-r--r--Command/FromKey.hs4
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/FsckFile.hs2
-rw-r--r--Command/Get.hs4
-rw-r--r--Command/Init.hs10
-rw-r--r--Command/Move.hs25
-rw-r--r--Command/PreCommit.hs2
-rw-r--r--Command/SetKey.hs2
-rw-r--r--Command/Unannex.hs2
-rw-r--r--Command/Unused.hs8
-rw-r--r--Core.hs2
-rw-r--r--Remotes.hs98
-rw-r--r--Utility.hs18
-rw-r--r--Version.hs4
23 files changed, 144 insertions, 159 deletions
diff --git a/Backend.hs b/Backend.hs
index 01a7298b4..d5d8efa03 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -30,7 +30,7 @@ module Backend (
) where
import Control.Monad.State
-import IO (try)
+import System.IO.Error (try)
import System.FilePath
import System.Posix.Files
diff --git a/Backend/File.hs b/Backend/File.hs
index c67fb3ce3..c0fc46992 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -34,7 +34,7 @@ backend = Backend {
storeFileKey = dummyStore,
retrieveKeyFile = copyKeyFile,
removeKey = checkRemoveKey,
- hasKey = checkKeyFile,
+ hasKey = inAnnex,
fsckKey = mustProvide
}
@@ -42,19 +42,15 @@ mustProvide :: a
mustProvide = error "must provide this field"
{- Storing a key is a no-op. -}
-dummyStore :: FilePath -> Key -> Annex (Bool)
+dummyStore :: FilePath -> Key -> Annex Bool
dummyStore _ _ = return True
-{- Just check if the .git/annex/ file for the key exists. -}
-checkKeyFile :: Key -> Annex Bool
-checkKeyFile k = inAnnex k
-
{- Try to find a copy of the file in one of the remotes,
- and copy it over to this one. -}
-copyKeyFile :: Key -> FilePath -> Annex (Bool)
+copyKeyFile :: Key -> FilePath -> Annex Bool
copyKeyFile key file = do
remotes <- Remotes.keyPossibilities key
- if (null remotes)
+ if null remotes
then do
showNote "not available"
showLocations key
@@ -68,76 +64,72 @@ copyKeyFile key file = do
return False
trycopy full (r:rs) = do
probablythere <- probablyPresent r
- if (probablythere)
+ if probablythere
then do
- showNote $ "copying from " ++ (Git.repoDescribe r) ++ "..."
+ showNote $ "copying from " ++ Git.repoDescribe r ++ "..."
copied <- Remotes.copyFromRemote r key file
- if (copied)
+ if copied
then return True
else trycopy full rs
else trycopy full rs
- probablyPresent r = do
- -- This check is to avoid an ugly message if a
- -- remote is a drive that is not mounted.
- -- Avoid checking inAnnex for ssh remotes because
- -- that is unnecessarily slow, and the locationlog
- -- should be trusted. (If the ssh remote is down
- -- or really lacks the file, it's ok to show
- -- an ugly message before going on to the next
- -- remote.)
- if (not $ Git.repoIsUrl r)
+ -- This check is to avoid an ugly message if a remote is a
+ -- drive that is not mounted. Avoid checking inAnnex for ssh
+ -- remotes because that is unnecessarily slow, and the
+ -- locationlog should be trusted. (If the ssh remote is down
+ -- or really lacks the file, it's ok to show an ugly message
+ -- before going on to the next remote.)
+ probablyPresent r =
+ if not $ Git.repoIsUrl r
then liftIO $ doesFileExist $ annexLocation r key
else return True
{- Checks remotes to verify that enough copies of a key exist to allow
- for a key to be safely removed (with no data loss), and fails with an
- error if not. -}
-checkRemoveKey :: Key -> Annex (Bool)
+checkRemoveKey :: Key -> Annex Bool
checkRemoveKey key = do
force <- Annex.flagIsSet "force"
- if (force)
+ if force
then return True
else do
remotes <- Remotes.keyPossibilities key
numcopies <- getNumCopies
- if (numcopies > length remotes)
+ if numcopies > length remotes
then notEnoughCopies numcopies (length remotes) []
else findcopies numcopies 0 remotes []
where
- findcopies need have [] bad =
- if (have >= need)
- then return True
- else notEnoughCopies need have bad
- findcopies need have (r:rs) bad = do
- if (have >= need)
- then return True
- else do
- haskey <- Remotes.inAnnex r key
- case (haskey) of
- Right True -> findcopies need (have+1) rs bad
- Right False -> findcopies need have rs bad
- Left _ -> findcopies need have rs (r:bad)
+ findcopies need have [] bad
+ | have >= need = return True
+ | otherwise = notEnoughCopies need have bad
+ findcopies need have (r:rs) bad
+ | have >= need = return True
+ | otherwise = do
+ haskey <- Remotes.inAnnex r key
+ case haskey of
+ Right True -> findcopies need (have+1) rs bad
+ Right False -> findcopies need have rs bad
+ Left _ -> findcopies need have rs (r:bad)
notEnoughCopies need have bad = do
unsafe
showLongNote $
"Could only verify the existence of " ++
- (show have) ++ " out of " ++ (show need) ++
+ show have ++ " out of " ++ show need ++
" necessary copies"
showTriedRemotes bad
showLocations key
hint
return False
unsafe = showNote "unsafe"
- hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)"
+ hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
showLocations :: Key -> Annex ()
showLocations key = do
g <- Annex.gitRepo
u <- getUUID g
uuids <- liftIO $ keyLocations g key
- let uuidsf = filter (\v -> v /= u) uuids
+ let uuidsf = filter (/= u) uuids
ppuuids <- prettyPrintUUIDs uuidsf
- if (null uuidsf)
+ if null uuidsf
then showLongNote $ "No other repository is known to contain the file."
else showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
@@ -145,7 +137,7 @@ showTriedRemotes :: [Git.Repo] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "I was unable to access these remotes: " ++
- (Remotes.list remotes)
+ Remotes.list remotes
getNumCopies :: Annex Int
getNumCopies = do
@@ -173,7 +165,7 @@ checkKeyNumCopies key = do
remotes <- Remotes.keyPossibilities key
inannex <- inAnnex key
let present = length remotes + if inannex then 1 else 0
- if (present < needed)
+ if present < needed
then do
warning $ note present needed
return False
diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs
index 46667c9cd..68f7f683b 100644
--- a/Backend/SHA1.hs
+++ b/Backend/SHA1.hs
@@ -33,15 +33,15 @@ sha1 file = do
liftIO $ pOpen ReadFromPipe "sha1sum" [file] $ \h -> do
line <- hGetLine h
let bits = split " " line
- if (null bits)
+ if null bits
then error "sha1sum parse error"
- else return $ bits !! 0
+ else return $ head bits
-- A key is a sha1 of its contents.
keyValue :: FilePath -> Annex (Maybe Key)
keyValue file = do
s <- sha1 file
- return $ Just $ Key ((name backend), s)
+ return $ Just $ Key (name backend, s)
-- A key's sha1 is checked during fsck.
checkKeySHA1 :: Key -> Annex Bool
@@ -49,11 +49,11 @@ checkKeySHA1 key = do
g <- Annex.gitRepo
let file = annexLocation g key
present <- liftIO $ doesFileExist file
- if (not present)
+ if not present
then return True
else do
s <- sha1 file
- if (s == keyName key)
+ if s == keyName key
then return True
else do
dest <- moveBad key
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 4e2177fed..e9d8c4285 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -37,11 +37,11 @@ backend = Backend.File.backend {
keyValue :: FilePath -> Annex (Maybe Key)
keyValue file = do
stat <- liftIO $ getFileStatus file
- return $ Just $ Key ((name backend), key stat)
+ return $ Just $ Key (name backend, key stat)
where
key stat = uniqueid stat ++ sep ++ base
- uniqueid stat = (show $ modificationTime stat) ++ sep ++
- (show $ fileSize stat)
+ uniqueid stat = show (modificationTime stat) ++ sep ++
+ show (fileSize stat)
base = takeFileName file
sep = ":"
@@ -58,11 +58,11 @@ checkKeySize key = do
g <- Annex.gitRepo
let file = annexLocation g key
present <- liftIO $ doesFileExist file
- if (not present)
+ if not present
then return True
else do
s <- liftIO $ getFileStatus file
- if (fileSize s == keySize key)
+ if fileSize s == keySize key
then return True
else do
dest <- moveBad key
diff --git a/Command/Add.hs b/Command/Add.hs
index 586807b53..cf32a8d64 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -28,7 +28,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start]
start :: SubCmdStartBackendFile
start pair@(file, _) = notAnnexed file $ do
s <- liftIO $ getSymbolicLinkStatus file
- if ((isSymbolicLink s) || (not $ isRegularFile s))
+ if (isSymbolicLink s) || (not $ isRegularFile s)
then return Nothing
else do
showStart "add" file
@@ -37,7 +37,7 @@ start pair@(file, _) = notAnnexed file $ do
perform :: (FilePath, Maybe Backend) -> SubCmdPerform
perform (file, backend) = do
stored <- Backend.storeFileKey file backend
- case (stored) of
+ case stored of
Nothing -> return Nothing
Just (key, _) -> return $ Just $ cleanup file key
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 1e73d8b82..fbe66f584 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -24,7 +24,7 @@ seek = [withFilesInGit start]
start :: SubCmdStartString
start file = isAnnexed file $ \(key, backend) -> do
inbackend <- Backend.hasKey key
- if (not inbackend)
+ if not inbackend
then return Nothing
else do
showStart "drop" file
@@ -33,13 +33,13 @@ start file = isAnnexed file $ \(key, backend) -> do
perform :: Key -> Backend -> SubCmdPerform
perform key backend = do
success <- Backend.removeKey backend key
- if (success)
+ if success
then return $ Just $ cleanup key
else return Nothing
cleanup :: Key -> SubCmdCleanup
cleanup key = do
inannex <- inAnnex key
- when (inannex) $ removeAnnex key
+ when inannex $ removeAnnex key
logStatus key ValueMissing
return True
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index 34010481d..aa72e1bbd 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -22,12 +22,12 @@ seek = [withKeys start]
start :: SubCmdStartString
start keyname = do
backends <- Backend.list
- let key = genKey (backends !! 0) keyname
+ let key = genKey (head backends) keyname
present <- inAnnex key
force <- Annex.flagIsSet "force"
- if (not present)
+ if not present
then return Nothing
- else if (not force)
+ else if not force
then error "dropkey is can cause data loss; use --force if you're sure you want to do this"
else do
showStart "dropkey" keyname
diff --git a/Command/Find.hs b/Command/Find.hs
index db0589fea..7b3c8c463 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -20,5 +20,5 @@ seek = [withDefault "." withFilesInGit start]
start :: SubCmdStartString
start file = isAnnexed file $ \(key, _) -> do
exists <- inAnnex key
- when (exists) $ liftIO $ putStrLn file
+ when exists $ liftIO $ putStrLn file
return Nothing
diff --git a/Command/Fix.hs b/Command/Fix.hs
index 323aca95e..33630031f 100644
--- a/Command/Fix.hs
+++ b/Command/Fix.hs
@@ -25,7 +25,7 @@ start :: SubCmdStartString
start file = isAnnexed file $ \(key, _) -> do
link <- calcGitLink file key
l <- liftIO $ readSymbolicLink file
- if (link == l)
+ if link == l
then return Nothing
else do
showStart "fix" file
diff --git a/Command/FromKey.hs b/Command/FromKey.hs
index f25de23a2..eb9ad5e51 100644
--- a/Command/FromKey.hs
+++ b/Command/FromKey.hs
@@ -29,10 +29,10 @@ start file = do
keyname <- Annex.flagGet "key"
when (null keyname) $ error "please specify the key with --key"
backends <- Backend.list
- let key = genKey (backends !! 0) keyname
+ let key = genKey (head backends) keyname
inbackend <- Backend.hasKey key
- unless (inbackend) $ error $
+ unless inbackend $ error $
"key ("++keyname++") is not present in backend"
showStart "fromkey" file
return $ Just $ perform file key
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 6291d5ba3..dc0168801 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -24,6 +24,6 @@ start file = isAnnexed file $ \(key, backend) -> do
perform :: Key -> Backend -> SubCmdPerform
perform key backend = do
success <- Backend.fsckKey backend key
- if (success)
+ if success
then return $ Just $ return True
else return Nothing
diff --git a/Command/FsckFile.hs b/Command/FsckFile.hs
index c74e94e62..e7c3d4915 100644
--- a/Command/FsckFile.hs
+++ b/Command/FsckFile.hs
@@ -24,6 +24,6 @@ start file = isAnnexed file $ \(key, backend) -> do
perform :: Key -> Backend -> SubCmdPerform
perform key backend = do
success <- Backend.fsckKey backend key
- if (success)
+ if success
then return $ Just $ return True
else return Nothing
diff --git a/Command/Get.hs b/Command/Get.hs
index 13d137537..628ed6293 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -20,7 +20,7 @@ seek = [withFilesInGit start]
start :: SubCmdStartString
start file = isAnnexed file $ \(key, backend) -> do
inannex <- inAnnex key
- if (inannex)
+ if inannex
then return Nothing
else do
showStart "get" file
@@ -29,7 +29,7 @@ start file = isAnnexed file $ \(key, backend) -> do
perform :: Key -> Backend -> SubCmdPerform
perform key backend = do
ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
- if (ok)
+ if ok
then return $ Just $ return True -- no cleanup needed
else return Nothing
diff --git a/Command/Init.hs b/Command/Init.hs
index c928647a5..eb5c58696 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -25,8 +25,8 @@ seek = [withString start]
{- Stores description for the repository etc. -}
start :: SubCmdStartString
start description = do
- when (null description) $ error $
- "please specify a description of this repository\n"
+ when (null description) $
+ error "please specify a description of this repository\n"
showStart "init" description
return $ Just $ perform description
@@ -38,7 +38,7 @@ perform description = do
setVersion
liftIO $ gitAttributes g
liftIO $ gitPreCommitHook g
- return $ Just $ cleanup
+ return $ Just cleanup
cleanup :: SubCmdCleanup
cleanup = do
@@ -53,7 +53,7 @@ cleanup = do
gitAttributes :: Git.Repo -> IO ()
gitAttributes repo = do
exists <- doesFileExist attributes
- if (not exists)
+ if not exists
then do
writeFile attributes $ attrLine ++ "\n"
commit
@@ -76,7 +76,7 @@ gitPreCommitHook repo = do
let hook = Git.workTree repo ++ "/" ++ Git.gitDir repo ++
"/hooks/pre-commit"
exists <- doesFileExist hook
- if (exists)
+ if exists
then putStrLn $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring"
else do
writeFile hook $ "#!/bin/sh\n" ++
diff --git a/Command/Move.hs b/Command/Move.hs
index 7f8f40737..c18054c90 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -7,8 +7,7 @@
module Command.Move where
-import Control.Monad.State (liftIO)
-import Monad (when)
+import Control.Monad.State (liftIO, when)
import Command
import qualified Command.Drop
@@ -53,7 +52,7 @@ start file = do
moveToStart :: SubCmdStartString
moveToStart file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
- if (not ishere)
+ if not ishere
then return Nothing -- not here, so nothing to do
else do
showStart "move" file
@@ -68,10 +67,10 @@ moveToPerform key = do
showNote $ show err
return Nothing
Right False -> do
- showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
- let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
+ showNote $ "moving to " ++ Git.repoDescribe remote ++ "..."
+ let tmpfile = annexTmpLocation remote ++ keyFile key
ok <- Remotes.copyToRemote remote key tmpfile
- if (ok)
+ if ok
then return $ Just $ moveToCleanup remote key tmpfile
else return Nothing -- failed
Right True -> return $ Just $ Command.Drop.cleanup key
@@ -79,7 +78,7 @@ moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
moveToCleanup remote key tmpfile = do
-- Tell remote to use the transferred content.
ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
- "--backend=" ++ (backendName key),
+ "--backend=" ++ backendName key,
"--key=" ++ keyName key,
tmpfile]
if ok
@@ -104,7 +103,7 @@ moveFromStart :: SubCmdStartString
moveFromStart file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote
l <- Remotes.keyPossibilities key
- if (null $ filter (\r -> Remotes.same r remote) l)
+ if null $ filter (\r -> Remotes.same r remote) l
then return Nothing
else do
showStart "move" file
@@ -113,18 +112,18 @@ moveFromPerform :: Key -> SubCmdPerform
moveFromPerform key = do
remote <- Remotes.commandLineRemote
ishere <- inAnnex key
- if (ishere)
+ if ishere
then return $ Just $ moveFromCleanup remote key
else do
- showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
- ok <- getViaTmp key (Remotes.copyFromRemote remote key)
- if (ok)
+ showNote $ "moving from " ++ Git.repoDescribe remote ++ "..."
+ ok <- getViaTmp key $ Remotes.copyFromRemote remote key
+ if ok
then return $ Just $ moveFromCleanup remote key
else return Nothing -- fail
moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
moveFromCleanup remote key = do
ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force",
- "--backend=" ++ (backendName key),
+ "--backend=" ++ backendName key,
keyName key]
when ok $ do
-- Record locally that the key is not on the remote.
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index a15510bd9..d4e5c04b9 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -28,7 +28,7 @@ start file = return $ Just $ perform file
perform :: FilePath -> SubCmdPerform
perform file = do
pairs <- Backend.chooseBackends [file]
- ok <- doSubCmd $ Command.Add.start $ pairs !! 0
+ ok <- doSubCmd $ Command.Add.start $ head pairs
if ok
then return $ Just $ cleanup file
else error $ "failed to add " ++ file ++ "; canceling commit"
diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index e8d407b83..685872f73 100644
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -28,7 +28,7 @@ start file = do
keyname <- Annex.flagGet "key"
when (null keyname) $ error "please specify the key with --key"
backends <- Backend.list
- let key = genKey (backends !! 0) keyname
+ let key = genKey (head backends) keyname
showStart "setkey" file
return $ Just $ perform file key
perform :: FilePath -> Key -> SubCmdPerform
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index e85e8486f..90ae55058 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -34,7 +34,7 @@ perform file key backend = do
-- force backend to always remove
Annex.flagChange "force" $ FlagBool True
ok <- Backend.removeKey backend key
- if (ok)
+ if ok
then return $ Just $ cleanup file key
else return Nothing
diff --git a/Command/Unused.hs b/Command/Unused.hs
index ae189550c..de34ceae9 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -35,7 +35,7 @@ checkUnused :: Annex Bool
checkUnused = do
showNote "checking for unused data..."
unused <- unusedKeys
- if (null unused)
+ if null unused
then return True
else do
let list = number 1 unused
@@ -48,9 +48,10 @@ checkUnused = do
w u = unlines $
["Some annexed data is no longer pointed to by any files in the repository:",
" NUMBER KEY"]
- ++ (map (\(n, k) -> " " ++ (pad 6 $ show n) ++ " " ++ show k) u) ++
+ ++ map cols u ++
["(To see where data was previously used, try: git log --stat -S'KEY')",
"(To remove unwanted data: git-annex dropunused NUMBER)"]
+ cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ show k
pad n s = s ++ replicate (n - length s) ' '
number :: Integer -> [a] -> [(Integer, a)]
@@ -71,8 +72,7 @@ unusedKeys = do
let unused_m = remove referenced present_m
return $ M.keys unused_m
where
- remove [] m = m
- remove (x:xs) m = remove xs $ M.delete x m
+ remove a b = foldl (flip M.delete) b a
existsMap :: Ord k => [k] -> M.Map k Int
existsMap l = M.fromList $ map (\k -> (k, 1)) l
diff --git a/Core.hs b/Core.hs
index 6e0ddd65f..b61d18666 100644
--- a/Core.hs
+++ b/Core.hs
@@ -7,7 +7,7 @@
module Core where
-import IO (try)
+import System.IO.Error (try)
import System.Directory
import Control.Monad.State (liftIO)
import System.Path
diff --git a/Remotes.hs b/Remotes.hs
index bf5ede572..cb8081d74 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -17,16 +17,14 @@ module Remotes (
runCmd
) where
-import IO (bracket_)
-import Control.Exception.Extensible hiding (bracket_)
+import Control.Exception.Extensible
import Control.Monad.State (liftIO)
-import Control.Monad (filterM)
import qualified Data.Map as Map
import Data.String.Utils
import System.Directory hiding (copyFile)
import System.Posix.Directory
-import List
-import Monad (when, unless)
+import Data.List
+import Control.Monad (when, unless, filterM)
import Types
import qualified GitRepo as Git
@@ -55,7 +53,7 @@ keyPossibilities key = do
-- But, reading the config of remotes can be expensive, so make
-- sure we only do it once per git-annex run.
remotesread <- Annex.flagIsSet "remotesread"
- if (remotesread)
+ if remotesread
then reposByUUID allremotes uuids
else do
-- We assume that it's cheap to read the config
@@ -65,11 +63,11 @@ keyPossibilities key = do
let cheap = filter (not . Git.repoIsUrl) allremotes
let expensive = filter Git.repoIsUrl allremotes
doexpensive <- filterM cachedUUID expensive
- unless (null doexpensive) $ do
+ unless (null doexpensive) $
showNote $ "getting UUID for " ++
- (list doexpensive) ++ "..."
+ list doexpensive ++ "..."
let todo = cheap ++ doexpensive
- if (not $ null todo)
+ if not $ null todo
then do
_ <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ FlagBool True
@@ -84,10 +82,9 @@ keyPossibilities key = do
- If the remote cannot be accessed, returns a Left error.
-}
inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
-inAnnex r key = do
- if (not $ Git.repoIsUrl r)
- then liftIO $ ((try checklocal)::IO (Either IOException Bool))
- else checkremote
+inAnnex r key = if Git.repoIsUrl r
+ then checkremote
+ else liftIO (try checklocal ::IO (Either IOException Bool))
where
checklocal = do
-- run a local check by making an Annex monad
@@ -112,12 +109,12 @@ reposByCost :: [Git.Repo] -> Annex [Git.Repo]
reposByCost l = do
notignored <- filterM repoNotIgnored l
costpairs <- mapM costpair notignored
- return $ fst $ unzip $ sortBy bycost $ costpairs
+ return $ fst $ unzip $ sortBy cmpcost costpairs
where
costpair r = do
cost <- repoCost r
return (r, cost)
- bycost (_, c1) (_, c2) = compare c1 c2
+ cmpcost (_, c1) (_, c2) = compare c1 c2
{- Calculates cost for a repo.
-
@@ -127,9 +124,9 @@ reposByCost l = do
repoCost :: Git.Repo -> Annex Int
repoCost r = do
cost <- repoConfig r "cost" ""
- if (not $ null cost)
+ if not $ null cost
then return $ read cost
- else if (Git.repoIsUrl r)
+ else if Git.repoIsUrl r
then return 200
else return 100
@@ -141,13 +138,12 @@ repoNotIgnored r = do
ignored <- repoConfig r "ignore" "false"
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
- let name = if (not $ null fromName) then fromName else toName
- if (not $ null name)
+ let name = if null fromName then toName else fromName
+ if not $ null name
then return $ match name
- else return $ not $ isIgnored ignored
+ else return $ not $ Git.configTrue ignored
where
match name = name == Git.repoRemoteName r
- isIgnored ignored = Git.configTrue ignored
{- Checks if two repos are the same, by comparing their remote names. -}
same :: Git.Repo -> Git.Repo -> Bool
@@ -158,14 +154,14 @@ commandLineRemote :: Annex Git.Repo
commandLineRemote = do
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
- let name = if (not $ null fromName) then fromName else toName
+ let name = if null fromName then toName else fromName
when (null name) $ error "no remote specified"
g <- Annex.gitRepo
let match = filter (\r -> name == Git.repoRemoteName r) $
Git.remotes g
when (null match) $ error $
"there is no git remote named \"" ++ name ++ "\""
- return $ match !! 0
+ return $ head match
{- The git configs for the git repo's remotes is not read on startup
- because reading it may be expensive. This function tries to read the
@@ -174,12 +170,12 @@ commandLineRemote = do
tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo)
tryGitConfigRead r = do
sshoptions <- repoConfig r "ssh-options" ""
- if (Map.null $ Git.configMap r)
+ if Map.null $ Git.configMap r
then do
-- configRead can fail due to IO error or
-- for other reasons; catch all possible exceptions
- result <- liftIO $ (try (Git.configRead r $ Just $ words sshoptions)::IO (Either SomeException (Git.Repo)))
- case (result) of
+ result <- liftIO (try (Git.configRead r $ Just $ words sshoptions)::IO (Either SomeException Git.Repo))
+ case result of
Left _ -> return $ Left r
Right r' -> do
g <- Annex.gitRepo
@@ -192,18 +188,16 @@ tryGitConfigRead r = do
where
exchange [] _ = []
exchange (old:ls) new =
- if (Git.repoRemoteName old == Git.repoRemoteName new)
- then new:(exchange ls new)
- else old:(exchange ls new)
+ if Git.repoRemoteName old == Git.repoRemoteName new
+ then new : exchange ls new
+ else old : exchange ls new
{- Tries to copy a key's content from a remote to a file. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
-copyFromRemote r key file = do
- if (not $ Git.repoIsUrl r)
- then getlocal
- else if (Git.repoIsSsh r)
- then getssh
- else error "copying from non-ssh repo not supported"
+copyFromRemote r key file
+ | not $ Git.repoIsUrl r = getlocal
+ | Git.repoIsSsh r = getssh
+ | otherwise = error "copying from non-ssh repo not supported"
where
getlocal = liftIO $ copyFile keyloc file
getssh = scp r [sshLocation r keyloc, file]
@@ -214,9 +208,9 @@ copyToRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyToRemote r key file = do
g <- Annex.gitRepo
let keyloc = annexLocation g key
- if (not $ Git.repoIsUrl r)
+ if not $ Git.repoIsUrl r
then putlocal keyloc
- else if (Git.repoIsSsh r)
+ else if Git.repoIsSsh r
then putssh keyloc
else error "copying to non-ssh repo not supported"
where
@@ -224,7 +218,7 @@ copyToRemote r key file = do
putssh src = scp r [src, sshLocation r file]
sshLocation :: Git.Repo -> FilePath -> FilePath
-sshLocation r file = (Git.urlHost r) ++ ":" ++ shellEscape file
+sshLocation r file = Git.urlHost r ++ ":" ++ shellEscape file
{- Runs scp against a specified remote. (Honors annex-scp-options.) -}
scp :: Git.Repo -> [String] -> Annex Bool
@@ -238,21 +232,21 @@ scp r params = do
runCmd :: Git.Repo -> String -> [String] -> Annex Bool
runCmd r command params = do
sshoptions <- repoConfig r "ssh-options" ""
- if (not $ Git.repoIsUrl r)
+ if not $ Git.repoIsUrl r
then do
- cwd <- liftIO $ getCurrentDirectory
- liftIO $ bracket_ (changeWorkingDirectory (Git.workTree r))
- (\_ -> changeWorkingDirectory cwd) $
- boolSystem command params
- else if (Git.repoIsSsh r)
- then do
- liftIO $ boolSystem "ssh" $
- (words sshoptions) ++
- [Git.urlHost r, "cd " ++
- (shellEscape $ Git.workTree r) ++
- " && " ++ (shellEscape command) ++ " " ++
- (unwords $ map shellEscape params)]
+ cwd <- liftIO getCurrentDirectory
+ liftIO $ bracket_
+ (changeWorkingDirectory (Git.workTree r))
+ (changeWorkingDirectory cwd)
+ (boolSystem command params)
+ else if Git.repoIsSsh r
+ then liftIO $ boolSystem "ssh" $
+ words sshoptions ++ [Git.urlHost r, sshcmd]
else error "running command in non-ssh repo not supported"
+ where
+ sshcmd = "cd " ++ shellEscape (Git.workTree r) ++
+ " && " ++ shellEscape command ++ " " ++
+ unwords (map shellEscape params)
{- Looks up a per-remote config option in git config.
- Failing that, tries looking for a global config option. -}
@@ -262,5 +256,5 @@ repoConfig r key def = do
let def' = Git.configGet g global def
return $ Git.configGet g local def'
where
- local = "remote." ++ (Git.repoRemoteName r) ++ ".annex-" ++ key
+ local = "remote." ++ Git.repoRemoteName r ++ ".annex-" ++ key
global = "annex." ++ key
diff --git a/Utility.hs b/Utility.hs
index 33db4bb08..2bea6e875 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -35,12 +35,12 @@ hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s
{- Returns the parent directory of a path. Parent of / is "" -}
parentDir :: String -> String
parentDir dir =
- if (not $ null dirs)
- then slash ++ (join s $ take ((length dirs) - 1) dirs)
+ if not $ null dirs
+ then slash ++ join s (take (length dirs - 1) dirs)
else ""
where
- dirs = filter (\x -> not $ null x) $ split s dir
- slash = if (not $ isAbsolute dir) then "" else s
+ dirs = filter (not . null) $ split s dir
+ slash = if isAbsolute dir then s else ""
s = [pathSeparator]
{- Constructs a relative path from the CWD to a directory.
@@ -58,7 +58,7 @@ relPathCwdToDir dir = do
where
-- absolute, normalized form of the directory
absnorm cwd =
- case (absNormPath cwd dir) of
+ case absNormPath cwd dir of
Just d -> d
Nothing -> error $ "unable to normalize " ++ dir
@@ -70,7 +70,7 @@ relPathCwdToDir dir = do
-}
relPathDirToDir :: FilePath -> FilePath -> FilePath
relPathDirToDir from to =
- if (not $ null path)
+ if not $ null path
then addTrailingPathSeparator path
else ""
where
@@ -80,8 +80,8 @@ relPathDirToDir from to =
common = map fst $ filter same $ zip pfrom pto
same (c,d) = c == d
uncommon = drop numcommon pto
- dotdots = take ((length pfrom) - numcommon) $ repeat ".."
- numcommon = length $ common
+ dotdots = replicate (length pfrom - numcommon) ".."
+ numcommon = length common
path = join s $ dotdots ++ uncommon
{- Run a system command, and returns True or False
@@ -124,4 +124,4 @@ shellEscape f = "'" ++ escaped ++ "'"
unsetFileMode :: FilePath -> FileMode -> IO ()
unsetFileMode f m = do
s <- getFileStatus f
- setFileMode f $ (fileMode s) `intersectFileModes` (complement m)
+ setFileMode f $ fileMode s `intersectFileModes` complement m
diff --git a/Version.hs b/Version.hs
index ce39c0c1b..839470120 100644
--- a/Version.hs
+++ b/Version.hs
@@ -25,13 +25,13 @@ getVersion :: Annex (Maybe String)
getVersion = do
g <- Annex.gitRepo
let v = Git.configGet g versionField ""
- if (not $ null v)
+ if not $ null v
then return $ Just v
else do
-- version 0 was not recorded in .git/config;
-- such a repo should have an annexDir
d <- liftIO $ doesDirectoryExist $ annexDir g
- if (d)
+ if d
then return $ Just "0"
else return Nothing -- no version yet
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 15:40:12 +0000