go go gadget hlint
This commit is contained in:
		
					parent
					
						
							
								9d26192350
							
						
					
				
			
			
				commit
				
					
						9f6b7935dd
					
				
			
		
					 21 changed files with 35 additions and 37 deletions
				
			
		|  | @ -111,7 +111,7 @@ chooseBackends :: [FilePath] -> Annex [BackendFile] | |||
| chooseBackends fs = do | ||||
| 	g <- Annex.gitRepo | ||||
| 	forced <- Annex.getState Annex.forcebackend | ||||
| 	if forced /= Nothing | ||||
| 	if isJust forced | ||||
| 		then do | ||||
| 			l <- orderedList | ||||
| 			return $ map (\f -> (Just $ head l, f)) fs | ||||
|  |  | |||
|  | @ -38,7 +38,7 @@ backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes | |||
| 
 | ||||
| genBackend :: SHASize -> Maybe (Backend Annex) | ||||
| genBackend size | ||||
| 	| shaCommand size == Nothing = Nothing | ||||
| 	| isNothing (shaCommand size) = Nothing | ||||
| 	| otherwise = Just b | ||||
| 	where | ||||
| 		b = Types.Backend.Backend | ||||
|  |  | |||
|  | @ -162,7 +162,7 @@ withNothing a [] = return [a] | |||
| withNothing _ _ = error "This command takes no parameters." | ||||
| 
 | ||||
| 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 a fs = runFilteredGen a snd (Backend.chooseBackends fs) | ||||
|  |  | |||
|  | @ -28,7 +28,7 @@ import Utility.Path | |||
| import Utility.Conditional | ||||
| 
 | ||||
| command :: [Command] | ||||
| command = [repoCommand "addurl" (paramRepeating $ paramUrl) seek | ||||
| command = [repoCommand "addurl" (paramRepeating paramUrl) seek | ||||
| 	"add urls to annex"] | ||||
| 
 | ||||
| seek :: [CommandSeek] | ||||
|  |  | |||
|  | @ -35,7 +35,7 @@ start ws = do | |||
| 	when (null ws) needname | ||||
| 
 | ||||
| 	(u, c) <- findByName name | ||||
| 	let fullconfig = M.union config c	 | ||||
| 	let fullconfig = config `M.union` c	 | ||||
| 	t <- findType fullconfig | ||||
| 
 | ||||
| 	showStart "initremote" name | ||||
|  |  | |||
|  | @ -12,6 +12,7 @@ import Control.Applicative | |||
| import System.Posix.Files | ||||
| import System.Directory | ||||
| import System.FilePath | ||||
| import Data.Maybe | ||||
| 
 | ||||
| import Command | ||||
| 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. -} | ||||
| {- Ideally, all keys have file size metadata. Old keys may not. -} | ||||
| upgradableKey :: Key -> Bool | ||||
| upgradableKey key = Types.Key.keySize key == Nothing | ||||
| upgradableKey key = isNothing $ Types.Key.keySize key | ||||
| 
 | ||||
| perform :: FilePath -> Key -> Backend Annex -> CommandPerform | ||||
| perform file oldkey newbackend = do | ||||
|  |  | |||
|  | @ -94,11 +94,11 @@ supported_remote_types = stat "supported remote types" $ | |||
| 
 | ||||
| local_annex_size :: Stat | ||||
| local_annex_size = stat "local annex size" $ | ||||
| 	cachedKeysPresent >>= return . keySizeSum | ||||
| 	keySizeSum <$> cachedKeysPresent | ||||
| 
 | ||||
| total_annex_size :: Stat | ||||
| total_annex_size = stat "total annex size" $ | ||||
| 	cachedKeysReferenced >>= return . keySizeSum | ||||
| 	keySizeSum <$> cachedKeysReferenced | ||||
| 
 | ||||
| local_annex_keys :: Stat | ||||
| local_annex_keys = stat "local annex keys" $ | ||||
|  |  | |||
							
								
								
									
										13
									
								
								Git.hs
									
										
									
									
									
								
							
							
						
						
									
										13
									
								
								Git.hs
									
										
									
									
									
								
							|  | @ -62,7 +62,7 @@ module Git ( | |||
| 	prop_idempotent_deencode | ||||
| ) where | ||||
| 
 | ||||
| import Control.Monad (unless, when) | ||||
| import Control.Monad (unless, when, liftM2) | ||||
| import Control.Applicative | ||||
| import System.Directory | ||||
| import System.FilePath | ||||
|  | @ -425,7 +425,7 @@ getSha :: String -> IO String -> IO String | |||
| getSha subcommand a = do | ||||
| 	t <- a | ||||
| 	let t' = if last t == '\n' | ||||
| 		then take (length t - 1) t | ||||
| 		then init t | ||||
| 		else t | ||||
| 	when (length t' /= shaSize) $ | ||||
| 		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")" | ||||
|  | @ -576,7 +576,7 @@ decodeGitFile f@(c:s) | |||
| 	| otherwise = f | ||||
| 	where | ||||
| 		e = '\\' | ||||
| 		middle = take (length s - 1) s | ||||
| 		middle = init s | ||||
| 		unescape (b, []) = b | ||||
| 		-- look for escapes starting with '\' | ||||
| 		unescape (b, v) = b ++ beginning ++ unescape (decode rest) | ||||
|  | @ -702,7 +702,6 @@ isRepoTop dir = do | |||
| 	where | ||||
| 		isRepo = gitSignature ".git" ".git/config" | ||||
| 		isBareRepo = gitSignature "objects" "config" | ||||
| 		gitSignature subdir file = do | ||||
| 			s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) | ||||
| 			f <- (doesFileExist (dir ++ "/" ++ file)) | ||||
| 			return (s && f) | ||||
| 		gitSignature subdir file = liftM2 (&&) | ||||
| 			(doesDirectoryExist (dir ++ "/" ++ subdir)) | ||||
| 			(doesFileExist (dir ++ "/" ++ file)) | ||||
|  |  | |||
|  | @ -108,11 +108,11 @@ options = commonOptions ++ | |||
| 		"override trust setting to untrusted" | ||||
| 	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE") | ||||
| 		"override git configuration setting" | ||||
| 	, Option ['x'] ["exclude"] (ReqArg (Limit.addExclude) paramGlob) | ||||
| 	, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob) | ||||
| 		"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" | ||||
| 	, Option ['C'] ["copies"] (ReqArg (Limit.addCopies) paramNumber) | ||||
| 	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber) | ||||
| 		"skip files with fewer copies" | ||||
| 	] ++ matcherOptions | ||||
| 	where | ||||
|  |  | |||
							
								
								
									
										3
									
								
								Init.hs
									
										
									
									
									
								
							
							
						
						
									
										3
									
								
								Init.hs
									
										
									
									
									
								
							|  | @ -33,8 +33,7 @@ initialize = do | |||
| 	gitPreCommitHookWrite | ||||
| 
 | ||||
| uninitialize :: Annex () | ||||
| uninitialize = do | ||||
| 	gitPreCommitHookUnWrite | ||||
| uninitialize = gitPreCommitHookUnWrite | ||||
| 
 | ||||
| {- Will automatically initialize if there is already a git-annex | ||||
|    branch from somewhere. Otherwise, require a manual init | ||||
|  |  | |||
							
								
								
									
										5
									
								
								Limit.hs
									
										
									
									
									
								
							
							
						
						
									
										5
									
								
								Limit.hs
									
										
									
									
									
								
							|  | @ -69,7 +69,7 @@ addExclude glob = addLimit $ return . notExcluded | |||
| addIn :: String -> Annex () | ||||
| addIn name = do | ||||
| 	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 | ||||
| 		check a f = Backend.lookupFile f >>= handle a | ||||
| 		handle _ Nothing = return False | ||||
|  | @ -77,12 +77,11 @@ addIn name = do | |||
| 		remote u key = do | ||||
| 			us <- keyLocations key | ||||
| 			return $ u `elem` us | ||||
| 		local key = inAnnex key | ||||
| 
 | ||||
| {- Adds a limit to skip files not believed to have the specified number | ||||
|  - of copies. -} | ||||
| addCopies :: String -> Annex () | ||||
| addCopies num = do | ||||
| addCopies num = | ||||
| 	case readMaybe num :: Maybe Int of | ||||
| 		Nothing -> error "bad number for --copies" | ||||
| 		Just n -> addLimit $ check n | ||||
|  |  | |||
|  | @ -58,5 +58,5 @@ matcherOptions = | |||
| 	, shortopt ")" "close group of options" | ||||
| 	] | ||||
| 	where | ||||
| 		longopt o d = Option [] [o] (NoArg (addToken o)) d | ||||
| 		shortopt o d = Option o [] (NoArg (addToken o)) d | ||||
| 		longopt o = Option [] [o] $ NoArg $ addToken o | ||||
| 		shortopt o = Option o [] $ NoArg $ addToken o | ||||
|  |  | |||
|  | @ -81,7 +81,7 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo | |||
| tryGitConfigRead r  | ||||
| 	| not $ M.null $ Git.configMap r = return r -- already read | ||||
| 	| 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 | ||||
| 	| otherwise = store $ safely $ do | ||||
| 		onLocal r ensureInitialized | ||||
|  | @ -101,7 +101,7 @@ tryGitConfigRead r | |||
| 
 | ||||
| 		geturlconfig = do | ||||
| 			s <- Url.get (Git.repoLocation r ++ "/config") | ||||
| 			withTempFile "git-annex.tmp" $ \tmpfile -> \h -> do | ||||
| 			withTempFile "git-annex.tmp" $ \tmpfile h -> do | ||||
| 				hPutStr h s | ||||
| 				hClose h | ||||
| 				pOpen ReadFromPipe "git" ["config", "--list", "--file", tmpfile] $ | ||||
|  |  | |||
|  | @ -95,7 +95,7 @@ s3Setup u c = handlehost $ M.lookup "host" c | |||
| 
 | ||||
| 		defaulthost = do | ||||
| 			c' <- encryptionSetup c | ||||
| 			let fullconfig = M.union c' defaults | ||||
| 			let fullconfig = c' `M.union` defaults | ||||
| 			genBucket fullconfig | ||||
| 			use fullconfig | ||||
| 
 | ||||
|  | @ -209,7 +209,7 @@ s3Bool (Left e) = s3Warning e | |||
| 
 | ||||
| s3Action :: Remote Annex -> a -> ((AWSConnection, String) -> Annex a) -> Annex a | ||||
| s3Action r noconn action = do | ||||
| 	when (config r == Nothing) $ | ||||
| 	when (isNothing $ config r) $ | ||||
| 		error $ "Missing configuration for special remote " ++ name r | ||||
| 	let bucket = M.lookup "bucket" $ fromJust $ config r | ||||
| 	conn <- s3Connection $ fromJust $ config r | ||||
|  |  | |||
|  | @ -173,7 +173,7 @@ readKey1 v = | |||
| 			then Just (read (bits !! 2) :: Integer) | ||||
| 			else Nothing | ||||
| 		wormy = head bits == "WORM" | ||||
| 		mixup = wormy && (isUpper $ head $ bits !! 1) | ||||
| 		mixup = wormy && isUpper (head $ bits !! 1) | ||||
| 
 | ||||
| showKey1 :: Key -> String | ||||
| 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" | ||||
| 
 | ||||
| stateDir :: FilePath | ||||
| stateDir = addTrailingPathSeparator $ ".git-annex" | ||||
| stateDir = addTrailingPathSeparator ".git-annex" | ||||
| 
 | ||||
| gitStateDir :: Git.Repo -> FilePath | ||||
| gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir | ||||
|  |  | |||
|  | @ -19,7 +19,7 @@ import Text.JSON | |||
|    later. -} | ||||
| start :: JSON a => [(String, a)] -> String | ||||
| start l | ||||
| 	| last s == endchar = take (length s - 1)  s | ||||
| 	| last s == endchar = init s | ||||
| 	| otherwise = bad s | ||||
| 	where | ||||
| 		s = encodeStrict $ toJSObject l | ||||
|  |  | |||
|  | @ -63,7 +63,7 @@ consume m (t:ts) = go t | |||
| 	where | ||||
| 		go And = cont $ m `MAnd` 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 Close = (m, ts) | ||||
| 		go (Operation o) = (m `MAnd` MOp o, ts) | ||||
|  |  | |||
|  | @ -19,7 +19,7 @@ import Control.Applicative | |||
| parentDir :: FilePath -> FilePath | ||||
| parentDir dir = | ||||
| 	if not $ null dirs | ||||
| 	then slash ++ join s (take (length dirs - 1) dirs) | ||||
| 	then slash ++ join s (init dirs) | ||||
| 	else "" | ||||
| 		where | ||||
| 			dirs = filter (not . null) $ split s dir | ||||
|  |  | |||
|  | @ -24,7 +24,7 @@ newtype TimeSpec = TimeSpec CTime | |||
| touchBoth :: FilePath -> TimeSpec -> 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/stat.h> | ||||
|  |  | |||
|  | @ -51,7 +51,7 @@ getVersionString = do | |||
| 	let verline = head $ lines changelog | ||||
| 	return $ middle (words verline !! 1) | ||||
| 	where | ||||
| 		middle s = drop 1 $ take (length s - 1) s | ||||
| 		middle = drop 1 . init | ||||
| 
 | ||||
| {- Set up cabal file with version. -} | ||||
| cabalSetup :: IO () | ||||
|  |  | |||
|  | @ -23,7 +23,7 @@ tmpIndex :: Git.Repo -> FilePath | |||
| tmpIndex g = Git.gitDir g </> "index.git-union-merge" | ||||
| 
 | ||||
| setup :: Git.Repo -> IO () | ||||
| setup g = cleanup g -- idempotency | ||||
| setup = cleanup -- idempotency | ||||
| 
 | ||||
| cleanup :: Git.Repo -> IO () | ||||
| cleanup g = do | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess