go go gadget hlint

This commit is contained in:
Joey Hess 2011-09-20 23:24:48 -04:00
parent 9d26192350
commit 9f6b7935dd
21 changed files with 35 additions and 37 deletions

View file

@ -111,7 +111,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile]
chooseBackends fs = do chooseBackends fs = do
g <- Annex.gitRepo g <- Annex.gitRepo
forced <- Annex.getState Annex.forcebackend forced <- Annex.getState Annex.forcebackend
if forced /= Nothing if isJust forced
then do then do
l <- orderedList l <- orderedList
return $ map (\f -> (Just $ head l, f)) fs return $ map (\f -> (Just $ head l, f)) fs

View file

@ -38,7 +38,7 @@ backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
genBackend :: SHASize -> Maybe (Backend Annex) genBackend :: SHASize -> Maybe (Backend Annex)
genBackend size genBackend size
| shaCommand size == Nothing = Nothing | isNothing (shaCommand size) = Nothing
| otherwise = Just b | otherwise = Just b
where where
b = Types.Backend.Backend b = Types.Backend.Backend

View file

@ -162,7 +162,7 @@ withNothing a [] = return [a]
withNothing _ _ = error "This command takes no parameters." withNothing _ _ = error "This command takes no parameters."
runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)] runFiltered :: (FilePath -> Annex (Maybe a)) -> Annex [FilePath] -> Annex [Annex (Maybe a)]
runFiltered a fs = runFilteredGen a id fs runFiltered a = runFilteredGen a id
backendPairs :: (BackendFile -> CommandStart) -> CommandSeek backendPairs :: (BackendFile -> CommandStart) -> CommandSeek
backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs) backendPairs a fs = runFilteredGen a snd (Backend.chooseBackends fs)

View file

@ -28,7 +28,7 @@ import Utility.Path
import Utility.Conditional import Utility.Conditional
command :: [Command] command :: [Command]
command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek command = [repoCommand "addurl" (paramRepeating paramUrl) seek
"add urls to annex"] "add urls to annex"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -35,7 +35,7 @@ start ws = do
when (null ws) needname when (null ws) needname
(u, c) <- findByName name (u, c) <- findByName name
let fullconfig = M.union config c let fullconfig = config `M.union` c
t <- findType fullconfig t <- findType fullconfig
showStart "initremote" name showStart "initremote" name

View file

@ -12,6 +12,7 @@ import Control.Applicative
import System.Posix.Files import System.Posix.Files
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import Data.Maybe
import Command import Command
import qualified Annex import qualified Annex
@ -48,7 +49,7 @@ start (b, file) = isAnnexed file $ \(key, oldbackend) -> do
{- Checks if a key is upgradable to a newer representation. -} {- Checks if a key is upgradable to a newer representation. -}
{- Ideally, all keys have file size metadata. Old keys may not. -} {- Ideally, all keys have file size metadata. Old keys may not. -}
upgradableKey :: Key -> Bool upgradableKey :: Key -> Bool
upgradableKey key = Types.Key.keySize key == Nothing upgradableKey key = isNothing $ Types.Key.keySize key
perform :: FilePath -> Key -> Backend Annex -> CommandPerform perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do perform file oldkey newbackend = do

View file

@ -94,11 +94,11 @@ supported_remote_types = stat "supported remote types" $
local_annex_size :: Stat local_annex_size :: Stat
local_annex_size = stat "local annex size" $ local_annex_size = stat "local annex size" $
cachedKeysPresent >>= return . keySizeSum keySizeSum <$> cachedKeysPresent
total_annex_size :: Stat total_annex_size :: Stat
total_annex_size = stat "total annex size" $ total_annex_size = stat "total annex size" $
cachedKeysReferenced >>= return . keySizeSum keySizeSum <$> cachedKeysReferenced
local_annex_keys :: Stat local_annex_keys :: Stat
local_annex_keys = stat "local annex keys" $ local_annex_keys = stat "local annex keys" $

13
Git.hs
View file

@ -62,7 +62,7 @@ module Git (
prop_idempotent_deencode prop_idempotent_deencode
) where ) where
import Control.Monad (unless, when) import Control.Monad (unless, when, liftM2)
import Control.Applicative import Control.Applicative
import System.Directory import System.Directory
import System.FilePath import System.FilePath
@ -425,7 +425,7 @@ getSha :: String -> IO String -> IO String
getSha subcommand a = do getSha subcommand a = do
t <- a t <- a
let t' = if last t == '\n' let t' = if last t == '\n'
then take (length t - 1) t then init t
else t else t
when (length t' /= shaSize) $ when (length t' /= shaSize) $
error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")" error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
@ -576,7 +576,7 @@ decodeGitFile f@(c:s)
| otherwise = f | otherwise = f
where where
e = '\\' e = '\\'
middle = take (length s - 1) s middle = init s
unescape (b, []) = b unescape (b, []) = b
-- look for escapes starting with '\' -- look for escapes starting with '\'
unescape (b, v) = b ++ beginning ++ unescape (decode rest) unescape (b, v) = b ++ beginning ++ unescape (decode rest)
@ -702,7 +702,6 @@ isRepoTop dir = do
where where
isRepo = gitSignature ".git" ".git/config" isRepo = gitSignature ".git" ".git/config"
isBareRepo = gitSignature "objects" "config" isBareRepo = gitSignature "objects" "config"
gitSignature subdir file = do gitSignature subdir file = liftM2 (&&)
s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) (doesDirectoryExist (dir ++ "/" ++ subdir))
f <- (doesFileExist (dir ++ "/" ++ file)) (doesFileExist (dir ++ "/" ++ file))
return (s && f)

View file

@ -108,11 +108,11 @@ options = commonOptions ++
"override trust setting to untrusted" "override trust setting to untrusted"
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE") , Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
"override git configuration setting" "override git configuration setting"
, Option ['x'] ["exclude"] (ReqArg (Limit.addExclude) paramGlob) , Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
"skip files matching the glob pattern" "skip files matching the glob pattern"
, Option ['i'] ["in"] (ReqArg (Limit.addIn) paramRemote) , Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)
"skip files not present in a remote" "skip files not present in a remote"
, Option ['C'] ["copies"] (ReqArg (Limit.addCopies) paramNumber) , Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
"skip files with fewer copies" "skip files with fewer copies"
] ++ matcherOptions ] ++ matcherOptions
where where

View file

@ -33,8 +33,7 @@ initialize = do
gitPreCommitHookWrite gitPreCommitHookWrite
uninitialize :: Annex () uninitialize :: Annex ()
uninitialize = do uninitialize = gitPreCommitHookUnWrite
gitPreCommitHookUnWrite
{- Will automatically initialize if there is already a git-annex {- Will automatically initialize if there is already a git-annex
branch from somewhere. Otherwise, require a manual init branch from somewhere. Otherwise, require a manual init

View file

@ -69,7 +69,7 @@ addExclude glob = addLimit $ return . notExcluded
addIn :: String -> Annex () addIn :: String -> Annex ()
addIn name = do addIn name = do
u <- Remote.nameToUUID name u <- Remote.nameToUUID name
addLimit $ if name == "." then check local else check (remote u) addLimit $ if name == "." then check inAnnex else check (remote u)
where where
check a f = Backend.lookupFile f >>= handle a check a f = Backend.lookupFile f >>= handle a
handle _ Nothing = return False handle _ Nothing = return False
@ -77,12 +77,11 @@ addIn name = do
remote u key = do remote u key = do
us <- keyLocations key us <- keyLocations key
return $ u `elem` us return $ u `elem` us
local key = inAnnex key
{- Adds a limit to skip files not believed to have the specified number {- Adds a limit to skip files not believed to have the specified number
- of copies. -} - of copies. -}
addCopies :: String -> Annex () addCopies :: String -> Annex ()
addCopies num = do addCopies num =
case readMaybe num :: Maybe Int of case readMaybe num :: Maybe Int of
Nothing -> error "bad number for --copies" Nothing -> error "bad number for --copies"
Just n -> addLimit $ check n Just n -> addLimit $ check n

View file

@ -58,5 +58,5 @@ matcherOptions =
, shortopt ")" "close group of options" , shortopt ")" "close group of options"
] ]
where where
longopt o d = Option [] [o] (NoArg (addToken o)) d longopt o = Option [] [o] $ NoArg $ addToken o
shortopt o d = Option o [] (NoArg (addToken o)) d shortopt o = Option o [] $ NoArg $ addToken o

View file

@ -81,7 +81,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r tryGitConfigRead r
| not $ M.null $ Git.configMap r = return r -- already read | not $ M.null $ Git.configMap r = return r -- already read
| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
| Git.repoIsHttp r = store $ safely $ geturlconfig | Git.repoIsHttp r = store $ safely geturlconfig
| Git.repoIsUrl r = return r | Git.repoIsUrl r = return r
| otherwise = store $ safely $ do | otherwise = store $ safely $ do
onLocal r ensureInitialized onLocal r ensureInitialized
@ -101,7 +101,7 @@ tryGitConfigRead r
geturlconfig = do geturlconfig = do
s <- Url.get (Git.repoLocation r ++ "/config") s <- Url.get (Git.repoLocation r ++ "/config")
withTempFile "git-annex.tmp" $ \tmpfile -> \h -> do withTempFile "git-annex.tmp" $ \tmpfile h -> do
hPutStr h s hPutStr h s
hClose h hClose h
pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $ pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $

View file

@ -95,7 +95,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
defaulthost = do defaulthost = do
c' <- encryptionSetup c c' <- encryptionSetup c
let fullconfig = M.union c' defaults let fullconfig = c' `M.union` defaults
genBucket fullconfig genBucket fullconfig
use fullconfig use fullconfig
@ -209,7 +209,7 @@ s3Bool (Left e) = s3Warning e
s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
s3Action r noconn action = do s3Action r noconn action = do
when (config r == Nothing) $ when (isNothing $ config r) $
error $ "Missing configuration for special remote " ++ name r error $ "Missing configuration for special remote " ++ name r
let bucket = M.lookup "bucket" $ fromJust $ config r let bucket = M.lookup "bucket" $ fromJust $ config r
conn <- s3Connection $ fromJust $ config r conn <- s3Connection $ fromJust $ config r

View file

@ -173,7 +173,7 @@ readKey1 v =
then Just (read (bits !! 2) :: Integer) then Just (read (bits !! 2) :: Integer)
else Nothing else Nothing
wormy = head bits == "WORM" wormy = head bits == "WORM"
mixup = wormy && (isUpper $ head $ bits !! 1) mixup = wormy && isUpper (head $ bits !! 1)
showKey1 :: Key -> String showKey1 :: Key -> String
showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } = showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =
@ -248,7 +248,7 @@ logFile' hasher repo key =
gitStateDir repo ++ hasher key ++ keyFile key ++ ".log" gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
stateDir :: FilePath stateDir :: FilePath
stateDir = addTrailingPathSeparator $ ".git-annex" stateDir = addTrailingPathSeparator ".git-annex"
gitStateDir :: Git.Repo -> FilePath gitStateDir :: Git.Repo -> FilePath
gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir

View file

@ -19,7 +19,7 @@ import Text.JSON
later. -} later. -}
start :: JSON a => [(String, a)] -> String start :: JSON a => [(String, a)] -> String
start l start l
| last s == endchar = take (length s - 1) s | last s == endchar = init s
| otherwise = bad s | otherwise = bad s
where where
s = encodeStrict $ toJSObject l s = encodeStrict $ toJSObject l

View file

@ -63,7 +63,7 @@ consume m (t:ts) = go t
where where
go And = cont $ m `MAnd` next go And = cont $ m `MAnd` next
go Or = cont $ m `MOr` next go Or = cont $ m `MOr` next
go Not = cont $ m `MAnd` (MNot next) go Not = cont $ m `MAnd` MNot next
go Open = let (n, r) = consume next rest in (m `MAnd` n, r) go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
go Close = (m, ts) go Close = (m, ts)
go (Operation o) = (m `MAnd` MOp o, ts) go (Operation o) = (m `MAnd` MOp o, ts)

View file

@ -19,7 +19,7 @@ import Control.Applicative
parentDir :: FilePath -> FilePath parentDir :: FilePath -> FilePath
parentDir dir = parentDir dir =
if not $ null dirs if not $ null dirs
then slash ++ join s (take (length dirs - 1) dirs) then slash ++ join s (init dirs)
else "" else ""
where where
dirs = filter (not . null) $ split s dir dirs = filter (not . null) $ split s dir

View file

@ -24,7 +24,7 @@ newtype TimeSpec = TimeSpec CTime
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO () touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
touch :: FilePath -> TimeSpec -> Bool -> IO () touch :: FilePath -> TimeSpec -> Bool -> IO ()
touch file mtime follow = touchBoth file mtime mtime follow touch file mtime = touchBoth file mtime mtime
#include <sys/types.h> #include <sys/types.h>
#include <sys/stat.h> #include <sys/stat.h>

View file

@ -51,7 +51,7 @@ getVersionString = do
let verline = head $ lines changelog let verline = head $ lines changelog
return $ middle (words verline !! 1) return $ middle (words verline !! 1)
where where
middle s = drop 1 $ take (length s - 1) s middle = drop 1 . init
{- Set up cabal file with version. -} {- Set up cabal file with version. -}
cabalSetup :: IO () cabalSetup :: IO ()

View file

@ -23,7 +23,7 @@ tmpIndex :: Git.Repo -> FilePath
tmpIndex g = Git.gitDir g </> "index.git-union-merge" tmpIndex g = Git.gitDir g </> "index.git-union-merge"
setup :: Git.Repo -> IO () setup :: Git.Repo -> IO ()
setup g = cleanup g -- idempotency setup = cleanup -- idempotency
cleanup :: Git.Repo -> IO () cleanup :: Git.Repo -> IO ()
cleanup g = do cleanup g = do