diff options
| -rw-r--r-- | Backend.hs | 8 | ||||
| -rw-r--r-- | Command.hs | 26 | ||||
| -rw-r--r-- | CopyFile.hs | 6 | ||||
| -rw-r--r-- | Core.hs | 12 | ||||
| -rw-r--r-- | GitQueue.hs | 4 | ||||
| -rw-r--r-- | GitRepo.hs | 28 | ||||
| -rw-r--r-- | LocationLog.hs | 20 | ||||
| -rw-r--r-- | Locations.hs | 6 | ||||
| -rw-r--r-- | Messages.hs | 9 | ||||
| -rw-r--r-- | TypeInternals.hs | 6 | ||||
| -rw-r--r-- | UUID.hs | 25 | ||||
| -rw-r--r-- | configure.hs | 6 |
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] @@ -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 ++ "\" }" @@ -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 |