hlint tweaks

Remotes.hs next, and also Backend/* and Command/*
This commit is contained in:
Joey Hess 2010-11-22 15:46:57 -04:00
parent fd11b5a3e5
commit 57adb0347b
12 changed files with 74 additions and 82 deletions

View file

@ -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

View file

@ -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

View file

@ -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]

12
Core.hs
View file

@ -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. -}

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ()

View file

@ -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 ++ "\" }"

25
UUID.hs
View file

@ -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"

View file

@ -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