summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Backend.hs8
-rw-r--r--Command.hs26
-rw-r--r--CopyFile.hs6
-rw-r--r--Core.hs12
-rw-r--r--GitQueue.hs4
-rw-r--r--GitRepo.hs28
-rw-r--r--LocationLog.hs20
-rw-r--r--Locations.hs6
-rw-r--r--Messages.hs9
-rw-r--r--TypeInternals.hs6
-rw-r--r--UUID.hs25
-rw-r--r--configure.hs6
12 files changed, 74 insertions, 82 deletions
diff --git a/Backend.hs b/Backend.hs
index f24347ca8..01a7298b4 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -45,21 +45,21 @@ import Messages
list :: Annex [Backend]
list = do
l <- Annex.backends -- list is cached here
- if (not $ null l)
+ if not $ null l
then return l
else do
bs <- Annex.supportedBackends
g <- Annex.gitRepo
let defaults = parseBackendList bs $ Git.configGet g "annex.backends" ""
backendflag <- Annex.flagGet "backend"
- let l' = if (not $ null backendflag)
+ let l' = if not $ null backendflag
then (lookupBackendName bs backendflag):defaults
else defaults
Annex.backendsChange l'
return l'
where
parseBackendList bs s =
- if (null s)
+ if null s
then bs
else map (lookupBackendName bs) $ words s
@@ -71,7 +71,7 @@ lookupBackendName bs s =
Nothing -> error $ "unknown backend " ++ s
maybeLookupBackendName :: [Backend] -> String -> Maybe Backend
maybeLookupBackendName bs s =
- if ((length matches) /= 1)
+ if 1 /= length matches
then Nothing
else Just $ head matches
where matches = filter (\b -> s == Internals.name b) bs
diff --git a/Command.hs b/Command.hs
index c6d2d0d5d..4d10a9e7f 100644
--- a/Command.hs
+++ b/Command.hs
@@ -64,17 +64,17 @@ prepSubCmd SubCommand { subcmdseek = seek } state params = do
doSubCmd :: SubCmdStart -> SubCmdCleanup
doSubCmd start = do
s <- start
- case (s) of
+ case s of
Nothing -> return True
Just perform -> do
p <- perform
- case (p) of
+ case p of
Nothing -> do
showEndFail
return False
Just cleanup -> do
c <- cleanup
- if (c)
+ if c
then do
showEndOk
return True
@@ -85,14 +85,14 @@ doSubCmd start = do
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = do
r <- Backend.lookupFile file
- case (r) of
+ case r of
Just _ -> return Nothing
Nothing -> a
isAnnexed :: FilePath -> ((Key, Backend) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = do
r <- Backend.lookupFile file
- case (r) of
+ case r of
Just v -> a v
Nothing -> return Nothing
@@ -153,19 +153,15 @@ withNothing _ _ = return []
{- Default to acting on all files matching the seek action if
- none are specified. -}
withAll :: SubCmdSeekStrings -> SubCmdSeekStrings
-withAll w a params = do
- if null params
- then do
- g <- Annex.gitRepo
- w a [Git.workTree g]
- else w a params
+withAll w a [] = do
+ g <- Annex.gitRepo
+ w a [Git.workTree g]
+withAll w a p = w a p
{- Provides a default parameter to act on if none is specified. -}
withDefault :: String-> SubCmdSeekStrings -> SubCmdSeekStrings
-withDefault d w a params = do
- if null params
- then w a [d]
- else w a params
+withDefault d w a [] = w a [d]
+withDefault _ w a p = w a p
{- filter out files from the state directory -}
notState :: FilePath -> Bool
diff --git a/CopyFile.hs b/CopyFile.hs
index 39f1b0183..8bd07dc35 100644
--- a/CopyFile.hs
+++ b/CopyFile.hs
@@ -15,10 +15,10 @@ import qualified SysConfig
copyFile :: FilePath -> FilePath -> IO Bool
copyFile src dest = boolSystem "cp" opts
where
- opts = if (SysConfig.cp_reflink_auto)
+ opts = if SysConfig.cp_reflink_auto
then ["--reflink=auto", src, dest]
- else if (SysConfig.cp_a)
+ else if SysConfig.cp_a
then ["-a", src, dest]
- else if (SysConfig.cp_p)
+ else if SysConfig.cp_p
then ["-p", src, dest]
else [src, dest]
diff --git a/Core.hs b/Core.hs
index 2928dc06d..6e0ddd65f 100644
--- a/Core.hs
+++ b/Core.hs
@@ -36,7 +36,7 @@ tryRun state actions = tryRun' state 0 actions
tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
tryRun' state errnum (a:as) = do
result <- try $ Annex.run state a
- case (result) of
+ case result of
Left err -> do
Annex.eval state $ showErr err
tryRun' state (errnum + 1) as
@@ -64,7 +64,7 @@ shutdown = do
g <- Annex.gitRepo
let tmp = annexTmpLocation g
exists <- liftIO $ doesDirectoryExist tmp
- when (exists) $ liftIO $ removeDirectoryRecursive tmp
+ when exists $ liftIO $ removeDirectoryRecursive tmp
liftIO $ createDirectoryIfMissing True tmp
return True
@@ -81,7 +81,7 @@ calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
g <- Annex.gitRepo
cwd <- liftIO $ getCurrentDirectory
- let absfile = case (absNormPath cwd file) of
+ let absfile = case absNormPath cwd file of
Just f -> f
Nothing -> error $ "unable to normalize " ++ file
return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++
@@ -104,7 +104,7 @@ getViaTmp key action = do
let tmp = annexTmpLocation g ++ keyFile key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
success <- action tmp
- if (success)
+ if success
then do
moveAnnex key tmp
logStatus key ValuePresent
@@ -125,7 +125,7 @@ preventWrite f = unsetFileMode f writebits
allowWrite :: FilePath -> IO ()
allowWrite f = do
s <- getFileStatus f
- setFileMode f $ (fileMode s) `unionFileModes` ownerWriteMode
+ setFileMode f $ fileMode s `unionFileModes` ownerWriteMode
{- Moves a file into .git/annex/objects/ -}
moveAnnex :: Key -> FilePath -> Annex ()
@@ -188,7 +188,7 @@ getKeysPresent' dir = do
where
present d = do
s <- getFileStatus $ dir ++ "/" ++ d ++ "/"
- ++ (takeFileName d)
+ ++ takeFileName d
return $ isRegularFile s
{- List of keys referenced by symlinks in the git repo. -}
diff --git a/GitQueue.hs b/GitQueue.hs
index 2d44a8f10..d8ba86136 100644
--- a/GitQueue.hs
+++ b/GitQueue.hs
@@ -45,7 +45,7 @@ add queue subcommand params file = M.insertWith (++) action [file] queue
{- Runs a queue on a git repository. -}
run :: Git.Repo -> Queue -> IO ()
run repo queue = do
- _ <- mapM (\(k, v) -> runAction repo k v) $ M.toList queue
+ _ <- mapM (uncurry $ runAction repo) $ M.toList queue
return ()
{- Runs an Action on a list of files in a git repository.
@@ -56,6 +56,6 @@ runAction repo action files = do
unless (null files) runxargs
where
runxargs = pOpen WriteToPipe "xargs" ("-0":gitcmd) feedxargs
- gitcmd = ["git"] ++ Git.gitCommandLine repo
+ gitcmd = "git" : Git.gitCommandLine repo
(getSubcommand action:getParams action)
feedxargs h = hPutStr h $ join "\0" files
diff --git a/GitRepo.hs b/GitRepo.hs
index fa78e5122..f50b3fb2e 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -127,19 +127,19 @@ repoIsSsh _ = False
assertLocal :: Repo -> a -> a
assertLocal repo action =
- if (not $ repoIsUrl repo)
+ if not $ repoIsUrl repo
then action
else error $ "acting on URL git repo " ++ repoDescribe repo ++
" not supported"
assertUrl :: Repo -> a -> a
assertUrl repo action =
- if (repoIsUrl repo)
+ if repoIsUrl repo
then action
else error $ "acting on local git repo " ++ repoDescribe repo ++
" not supported"
assertSsh :: Repo -> a -> a
assertSsh repo action =
- if (repoIsSsh repo)
+ if repoIsSsh repo
then action
else error $ "unsupported url in repo " ++ repoDescribe repo
bare :: Repo -> Bool
@@ -199,14 +199,14 @@ urlPath repo = assertUrl repo $ error "internal"
gitCommandLine :: Repo -> [String] -> [String]
gitCommandLine repo@(Repo { location = Dir d} ) params =
-- force use of specified repo via --git-dir and --work-tree
- ["--git-dir="++d++"/"++(gitDir repo), "--work-tree="++d] ++ params
+ ["--git-dir=" ++ d ++ "/" ++ gitDir repo, "--work-tree=" ++ d] ++ params
gitCommandLine repo _ = assertLocal repo $ error "internal"
{- Runs git in the specified repo, throwing an error if it fails. -}
run :: Repo -> [String] -> IO ()
run repo params = assertLocal repo $ do
ok <- boolSystem "git" (gitCommandLine repo params)
- unless (ok) $ error $ "git " ++ show params ++ " failed"
+ unless ok $ error $ "git " ++ show params ++ " failed"
{- Runs a git subcommand and returns its output. -}
pipeRead :: Repo -> [String] -> IO String
@@ -290,7 +290,7 @@ configRead repo sshopts = assertSsh repo $ do
params = case sshopts of
Nothing -> [urlHost repo, command]
Just l -> l ++ [urlHost repo, command]
- command = "cd " ++ (shellEscape $ urlPath repo) ++
+ command = "cd " ++ shellEscape (urlPath repo) ++
" && git config --list"
hConfigRead :: Repo -> Handle -> IO Repo
hConfigRead repo h = do
@@ -308,8 +308,8 @@ configRemotes repo = map construct remotepairs
where
remotepairs = Map.toList $ filterremotes $ config repo
filterremotes = Map.filterWithKey (\k _ -> isremote k)
- isremote k = (startswith "remote." k) && (endswith ".url" k)
- remotename k = (split "." k) !! 1
+ isremote k = startswith "remote." k && endswith ".url" k
+ remotename k = split "." k !! 1
construct (k,v) = (gen v) { remoteName = Just $ remotename k }
gen v | isURI v = repoFromUrl v
| otherwise = repoFromPath v
@@ -319,7 +319,7 @@ configParse :: String -> Map.Map String String
configParse s = Map.fromList $ map pair $ lines s
where
pair l = (key l, val l)
- key l = (keyval l) !! 0
+ key l = head $ keyval l
val l = join sep $ drop 1 $ keyval l
keyval l = split sep l :: [String]
sep = "="
@@ -377,7 +377,7 @@ decodeGitFile f@(c:s)
alloctal = isOctDigit n1 &&
isOctDigit n2 &&
isOctDigit n3
- fromoctal = [chr $ readoctal (n1:n2:n3:[])]
+ fromoctal = [chr $ readoctal [n1, n2, n3]]
readoctal o = read $ "0o" ++ o :: Int
-- \C is used for a few special characters
decode (x:nc:rest)
@@ -395,9 +395,9 @@ decodeGitFile f@(c:s)
{- Should not need to use this, except for testing decodeGitFile. -}
encodeGitFile :: FilePath -> String
-encodeGitFile s = (foldl (++) "\"" (map echar s)) ++ "\""
+encodeGitFile s = foldl (++) "\"" (map echar s) ++ "\""
where
- e c = "\\" ++ [c]
+ e c = '\\' : [c]
echar '\a' = e 'a'
echar '\b' = e 'b'
echar '\f' = e 'f'
@@ -413,7 +413,7 @@ encodeGitFile s = (foldl (++) "\"" (map echar s)) ++ "\""
| ord x > 0x7E = e_num x -- high ascii
| otherwise = [x] -- printable ascii
where
- showoctal i = "\\" ++ (printf "%03o" i)
+ showoctal i = '\\' : printf "%03o" i
e_num c = showoctal $ ord c
-- unicode character is decomposed to
-- Word8s and each is shown in octal
@@ -423,7 +423,7 @@ encodeGitFile s = (foldl (++) "\"" (map echar s)) ++ "\""
{- for quickcheck -}
prop_idempotent_deencode :: String -> Bool
-prop_idempotent_deencode s = s == (decodeGitFile $ encodeGitFile s)
+prop_idempotent_deencode s = s == decodeGitFile (encodeGitFile s)
{- Finds the current git repository, which may be in a parent directory. -}
repoFromCwd :: IO Repo
diff --git a/LocationLog.hs b/LocationLog.hs
index 1ddbf3c0b..7497d865b 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -66,8 +66,8 @@ instance Read LogLine where
-- read without an exception being thrown.
-- Such lines have a status of Undefined.
readsPrec _ string =
- if (length w == 3)
- then case (pdate) of
+ if length w == 3
+ then case pdate of
Just v -> good v
Nothing -> bad
else bad
@@ -75,15 +75,16 @@ instance Read LogLine where
w = words string
s = read $ w !! 1
u = w !! 2
- pdate = (parseTime defaultTimeLocale "%s%Qs" $ w !! 0) :: Maybe UTCTime
+ pdate :: Maybe UTCTime
+ pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s u
- bad = ret $ LogLine (0) Undefined ""
+ bad = ret $ LogLine 0 Undefined ""
ret v = [(v, "")]
{- Log a change in the presence of a key's value in a repository,
- and returns the filename of the logfile. -}
-logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO (FilePath)
+logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath
logChange repo key u s = do
line <- logNow s u
ls <- readLog logfile
@@ -101,10 +102,9 @@ readLog file = do
then do
s <- readFile file
-- filter out any unparsable lines
- return $ filter (\l -> (status l) /= Undefined )
+ return $ filter (\l -> status l /= Undefined )
$ map read $ lines s
- else do
- return []
+ else return []
{- Writes a set of lines to a log file -}
writeLog :: FilePath -> [LogLine] -> IO ()
@@ -124,7 +124,7 @@ logNow s u = do
{- Returns the filename of the log file for a given key. -}
logFile :: Git.Repo -> Key -> String
logFile repo key =
- (gitStateDir repo) ++ (Git.relative repo (keyFile key)) ++ ".log"
+ gitStateDir repo ++ Git.relative repo (keyFile key) ++ ".log"
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
@@ -152,7 +152,7 @@ compactLog' m (l:ls) = compactLog' (mapLog m l) ls
- information about a repo than the other logs in the map -}
mapLog :: LogMap -> LogLine -> LogMap
mapLog m l =
- if (better)
+ if better
then Map.insert u l m
else m
where
diff --git a/Locations.hs b/Locations.hs
index 24ccc75c6..6c541e937 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -31,12 +31,12 @@ import qualified GitRepo as Git
stateLoc :: String
stateLoc = ".git-annex/"
gitStateDir :: Git.Repo -> FilePath
-gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
+gitStateDir repo = Git.workTree repo ++ "/" ++ stateLoc
{- Annexed file's absolute location. -}
annexLocation :: Git.Repo -> Key -> FilePath
annexLocation r key =
- (Git.workTree r) ++ "/" ++ (annexLocationRelative key)
+ Git.workTree r ++ "/" ++ annexLocationRelative key
{- Annexed file's location relative to git's working tree.
-
@@ -90,5 +90,5 @@ fileKey file = read $
{- for quickcheck -}
prop_idempotent_fileKey :: String -> Bool
-prop_idempotent_fileKey s = k == (fileKey $ keyFile k)
+prop_idempotent_fileKey s = k == fileKey (keyFile k)
where k = read $ "test:" ++ s
diff --git a/Messages.hs b/Messages.hs
index f9d12c222..e1cf1539a 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -37,17 +37,14 @@ showProgress :: Annex ()
showProgress = verbose $ liftIO $ putStr "\n"
showLongNote :: String -> Annex ()
-showLongNote s = verbose $ do
- liftIO $ putStr $ "\n" ++ indented
+showLongNote s = verbose $ liftIO $ putStr $ "\n" ++ indented
where
indented = join "\n" $ map (\l -> " " ++ l) $ lines s
showEndOk :: Annex ()
-showEndOk = verbose $ do
- liftIO $ putStrLn "ok"
+showEndOk = verbose $ liftIO $ putStrLn "ok"
showEndFail :: Annex ()
-showEndFail = verbose $ do
- liftIO $ putStrLn "\nfailed"
+showEndFail = verbose $ liftIO $ putStrLn "\nfailed"
{- Exception pretty-printing. -}
showErr :: (Show a) => a -> Annex ()
diff --git a/TypeInternals.hs b/TypeInternals.hs
index 3078224b1..bcef4ee0a 100644
--- a/TypeInternals.hs
+++ b/TypeInternals.hs
@@ -51,10 +51,10 @@ instance Show Key where
show (Key (b, k)) = b ++ ":" ++ k
instance Read Key where
- readsPrec _ s = [((Key (b,k)) ,"")]
+ readsPrec _ s = [(Key (b,k), "")]
where
l = split ":" s
- b = l !! 0
+ b = head l
k = join ":" $ drop 1 l
backendName :: Key -> BackendName
@@ -81,4 +81,4 @@ data Backend = Backend {
}
instance Show Backend where
- show backend = "Backend { name =\"" ++ (name backend) ++ "\" }"
+ show backend = "Backend { name =\"" ++ name backend ++ "\" }"
diff --git a/UUID.hs b/UUID.hs
index 0f8a2173e..41a35327d 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -20,8 +20,8 @@ module UUID (
) where
import Control.Monad.State
-import Maybe
-import List
+import Data.Maybe
+import Data.List
import System.Cmd.Utils
import System.IO
import System.Directory
@@ -57,7 +57,7 @@ getUUID r = do
let c = cached g
let u = uncached
- if (c /= u && u /= "")
+ if c /= u && u /= ""
then do
updatecache g u
return u
@@ -66,7 +66,7 @@ getUUID r = do
uncached = Git.configGet r "annex.uuid" ""
cached g = Git.configGet g cachekey ""
updatecache g u = when (g /= r) $ Annex.setConfig cachekey u
- cachekey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
+ cachekey = "remote." ++ Git.repoRemoteName r ++ ".annex-uuid"
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
@@ -79,8 +79,7 @@ prepUUID = do
{- Filters a list of repos to ones that have listed UUIDs. -}
reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo]
-reposByUUID repos uuids = do
- filterM match repos
+reposByUUID repos uuids = filterM match repos
where
match r = do
u <- getUUID r
@@ -90,11 +89,11 @@ reposByUUID repos uuids = do
prettyPrintUUIDs :: [UUID] -> Annex String
prettyPrintUUIDs uuids = do
m <- uuidMap
- return $ unwords $ map (\u -> "\t"++(prettify m u)++"\n") uuids
+ return $ unwords $ map (\u -> "\t" ++ prettify m u ++ "\n") uuids
where
prettify m u =
- if (not $ null $ findlog m u)
- then u ++ " -- " ++ (findlog m u)
+ if not $ null $ findlog m u
+ then u ++ " -- " ++ findlog m u
else u
findlog m u = M.findWithDefault "" u m
@@ -117,11 +116,11 @@ uuidMap :: Annex (M.Map UUID String)
uuidMap = do
logfile <- uuidLog
s <- liftIO $ catch (readFile logfile) ignoreerror
- return $ M.fromList $ map (\l -> pair l) $ lines s
+ return $ M.fromList $ map pair $ lines s
where
pair l =
- if (1 < (length $ words l))
- then ((words l) !! 0, unwords $ drop 1 $ words l)
+ if 1 < length (words l)
+ then (head $ words l, unwords $ drop 1 $ words l)
else ("", "")
ignoreerror _ = return ""
@@ -129,4 +128,4 @@ uuidMap = do
uuidLog :: Annex String
uuidLog = do
g <- Annex.gitRepo
- return $ (gitStateDir g) ++ "uuid.log"
+ return $ gitStateDir g ++ "uuid.log"
diff --git a/configure.hs b/configure.hs
index 4d0624a42..7d3fc0127 100644
--- a/configure.hs
+++ b/configure.hs
@@ -10,7 +10,7 @@ data TestDesc = TestDesc String String Test
data Config = Config String Bool
instance Show Config where
- show (Config key value) = unlines $ [
+ show (Config key value) = unlines [
key ++ " :: Bool"
, key ++ " = " ++ show value
]
@@ -36,7 +36,7 @@ quiet s = s ++ " >/dev/null 2>&1"
requireCommand :: String -> String -> Test
requireCommand command cmdline = do
ret <- testCmd $ quiet cmdline
- if (ret)
+ if ret
then return True
else do
testEnd False
@@ -57,7 +57,7 @@ testStart s = do
hFlush stdout
testEnd :: Bool -> IO ()
-testEnd r = putStrLn $ " " ++ (show r)
+testEnd r = putStrLn $ " " ++ show r
writeSysConfig :: [Config] -> IO ()
writeSysConfig config = writeFile "SysConfig.hs" body