hlint

test suite still passes

Annex/CheckIgnore.hs

@@ -25,7 +25,7 @@ checkIgnoreHandle :: Annex (Maybe Git.CheckIgnoreHandle)
 checkIgnoreHandle = maybe startup return =<< Annex.getState Annex.checkignorehandle
   where
 	startup = do
-		v <- inRepo $ Git.checkIgnoreStart
+		v <- inRepo Git.checkIgnoreStart
 		when (isNothing v) $
 			warning "The installed version of git is too old for .gitignores to be honored by git-annex."
 		Annex.changeState $ \s -> s { Annex.checkignorehandle = Just v }

Annex/Content.hs

@@ -275,7 +275,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
 		thawContentDir =<< calcRepo (gitAnnexLocation key)
 		thawContent src
 		v <- isAnnexLink f
-		if (Just key == v)
+		if Just key == v
 			then do
 				updateInodeCache key src
 				replaceFile f $ liftIO . moveFile src

Annex/Content/Direct.hs

@@ -199,7 +199,7 @@ compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )
 addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex ()
 addContentWhenNotPresent key contentfile associatedfile = do
 	v <- isAnnexLink associatedfile
-	when (Just key == v) $ do
+	when (Just key == v) $
 		replaceFile associatedfile $
 			liftIO . void . copyFileExternal contentfile
 	updateInodeCache key associatedfile	

Annex/Environment.hs

@@ -32,7 +32,7 @@ import Utility.Env
 checkEnvironment :: Annex ()
 checkEnvironment = do
 	gitusername <- fromRepo $ Git.Config.getMaybe "user.name"
-	when (gitusername == Nothing || gitusername == Just "") $
+	when (isNothing gitusername || gitusername == Just "") $
 		liftIO checkEnvironmentIO
 
 checkEnvironmentIO :: IO ()

Annex/Exception.hs

@@ -24,7 +24,7 @@ import Common.Annex
 
 {- Runs an Annex action, with setup and cleanup both in the IO monad. -}
 bracketIO :: IO v -> (v -> IO b) -> (v -> Annex a) -> Annex a
-bracketIO setup cleanup go = M.bracket (liftIO setup) (liftIO . cleanup) go
+bracketIO setup cleanup = M.bracket (liftIO setup) (liftIO . cleanup)
 
 {- try in the Annex monad -}
 tryAnnex :: Annex a -> Annex (Either SomeException a)

Annex/Link.hs

@@ -68,9 +68,9 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 				-- characters, or whitespace, we
 				-- certianly don't have a link to a
 				-- git-annex key.
-				if any (`elem` s) "\0\n\r \t"
+				return $ if any (`elem` s) "\0\n\r \t"
-					then return ""
+					then ""
-					else return s
+					else s
 
 {- Creates a link on disk.
  -

Annex/Quvi.hs

@@ -14,7 +14,7 @@ import qualified Annex
 import Utility.Quvi
 import Utility.Url
 
-withQuviOptions :: forall a. (Query a) -> [CommandParam] -> URLString -> Annex a
+withQuviOptions :: forall a. Query a -> [CommandParam] -> URLString -> Annex a
 withQuviOptions a ps url = do
 	opts <- map Param . annexQuviOptions <$> Annex.getGitConfig
 	liftIO $ a (ps++opts) url

Annex/Ssh.hs

@@ -42,7 +42,7 @@ sshCachingOptions (host, port) opts = go =<< sshInfo (host, port)
 	-- If the lock pool is empty, this is the first ssh of this
 	-- run. There could be stale ssh connections hanging around
 	-- from a previous git-annex run that was interrupted.
-	cleanstale = whenM (not . any isLock . M.keys <$> getPool) $
+	cleanstale = whenM (not . any isLock . M.keys <$> getPool)
 		sshCleanup
 
 {- Returns a filename to use for a ssh connection caching socket, and
@@ -57,9 +57,9 @@ sshInfo (host, port) = go =<< sshCacheDir
 			then return (Just socketfile, sshConnectionCachingParams socketfile)
 			else do
 				socketfile' <- liftIO $ relPathCwdToFile socketfile
-				if valid_unix_socket_path socketfile'
+				return $ if valid_unix_socket_path socketfile'
-					then return (Just socketfile', sshConnectionCachingParams socketfile')
+					then (Just socketfile', sshConnectionCachingParams socketfile')
-					else return (Nothing, [])
+					else (Nothing, [])
 
 sshConnectionCachingParams :: FilePath -> [CommandParam]
 sshConnectionCachingParams socketfile = 

Backend/SHA.hs

@@ -31,11 +31,11 @@ backends :: [Backend]
 backends = catMaybes $ map genBackendE sizes ++ map genBackend sizes
 
 genBackend :: SHASize -> Maybe Backend
-genBackend size = Just $ Backend
+genBackend size = Just Backend
 	{ name = shaName size
 	, getKey = keyValue size
 	, fsckKey = Just $ checkKeyChecksum size
-	, canUpgradeKey = Just $ needsUpgrade
+	, canUpgradeKey = Just needsUpgrade
 	}
 
 genBackendE :: SHASize -> Maybe Backend

Command/Add.hs

@@ -98,13 +98,13 @@ start file = ifAnnexed file addpresent add
  - Lockdown can fail if a file gets deleted, and Nothing will be returned.
  -}
 lockDown :: FilePath -> Annex (Maybe KeySource)
-lockDown file = ifM (crippledFileSystem)
+lockDown file = ifM crippledFileSystem
 	( liftIO $ catchMaybeIO nohardlink
 	, do
 		tmp <- fromRepo gitAnnexTmpDir
 		createAnnexDirectory tmp
-		unlessM (isDirect) $ liftIO $
+		unlessM isDirect $ 
-			void $ tryIO $ preventWrite file
+			void $ liftIO $ tryIO $ preventWrite file
 		liftIO $ catchMaybeIO $ do
 			(tmpfile, h) <- openTempFile tmp $
 				relatedTemplate $ takeFileName file
@@ -115,7 +115,7 @@ lockDown file = ifM (crippledFileSystem)
   where
   	nohardlink = do
 		cache <- genInodeCache file
-		return $ KeySource
+		return KeySource
 			{ keyFilename = file
 			, contentLocation = file
 			, inodeCache = cache
@@ -123,7 +123,7 @@ lockDown file = ifM (crippledFileSystem)
 	withhardlink tmpfile = do
 		createLink file tmpfile
 		cache <- genInodeCache tmpfile
-		return $ KeySource
+		return KeySource
 			{ keyFilename = file
 			, contentLocation = tmpfile
 			, inodeCache = cache
@@ -134,7 +134,7 @@ lockDown file = ifM (crippledFileSystem)
  - In direct mode, leaves the file alone, and just updates bookkeeping
  - information.
  -}
-ingest :: (Maybe KeySource) -> Annex (Maybe Key)
+ingest :: Maybe KeySource -> Annex (Maybe Key)
 ingest Nothing = return Nothing
 ingest (Just source) = do
 	backend <- chooseBackend $ keyFilename source
@@ -205,7 +205,7 @@ link file key hascontent = flip catchAnnex (undo file key) $ do
 	replaceFile file $ makeAnnexLink l
 
 #ifndef __ANDROID__
-	when hascontent $ do
+	when hascontent $
 		-- touch the symlink to have the same mtime as the
 		-- file it points to
 		liftIO $ do

Command/EnableRemote.hs

@@ -43,7 +43,7 @@ unknownNameError prefix = do
 	error $ prefix ++
 		if null names
 			then ""
-			else " Known special remotes: " ++ intercalate " " names
+			else " Known special remotes: " ++ unwords names
 
 perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
 perform t u c = do

Command/Fsck.hs

@@ -104,7 +104,7 @@ withIncremental = withValue $ do
 				Nothing -> noop
 				Just started -> do
 					now <- liftIO getPOSIXTime
-					when (now - realToFrac started >= delta) $
+					when (now - realToFrac started >= delta)
 						resetStartTime
 		return True
 
@@ -187,7 +187,7 @@ performAll key backend = check
 	]
 
 check :: [Annex Bool] -> Annex Bool
-check cs = all id <$> sequence cs
+check cs = and <$> sequence cs
 
 {- Checks that the file's link points correctly to the content.
  -
@@ -225,7 +225,7 @@ verifyLocationLog key desc = do
 
 	{- In direct mode, modified files will show up as not present,
 	 - but that is expected and not something to do anything about. -}
-	if (direct && not present)
+	if direct && not present
 		then return True
 		else verifyLocationLog' key desc present u (logChange key u)
 
@@ -345,7 +345,7 @@ checkBackend backend key mfile = go =<< isDirect
 checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
 checkBackendRemote backend key remote = maybe (return True) go
   where
-	go file = checkBackendOr (badContentRemote remote) backend key file
+	go = checkBackendOr (badContentRemote remote) backend key
 
 checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
 checkBackendOr bad backend key file =
@@ -406,7 +406,7 @@ badContentDirect :: FilePath -> Key -> Annex String
 badContentDirect file key = do
 	void $ liftIO $ catchMaybeIO $ touchFile file
 	logStatus key InfoMissing
-	return $ "left in place for you to examine"
+	return "left in place for you to examine"
 
 badContentRemote :: Remote -> Key -> Annex String
 badContentRemote remote key = do

Command/Get.hs

@@ -75,7 +75,7 @@ getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key
 			( docopy r (trycopy full rs)
 			, trycopy full rs
 			)
-	showlocs = Remote.showLocations key [] $
+	showlocs = Remote.showLocations key []
 		"No other repository is known to contain the file."
 	-- This check is to avoid an ugly message if a remote is a
 	-- drive that is not mounted.

Command/ImportFeed.hs

@@ -50,8 +50,7 @@ perform relaxed cache url = do
 	v <- findEnclosures url
 	case v of
 		Just l | not (null l) -> do
-			ok <- all id
+			ok <- and <$> mapM (downloadEnclosure relaxed cache) l
-				<$> mapM (downloadEnclosure relaxed cache) l
 			unless ok $
 				feedProblem url "problem downloading item"
 			next $ cleanup url True

Command/Indirect.hs

@@ -46,7 +46,7 @@ start = ifM isDirect
 perform :: CommandPerform
 perform = do
 	showStart "commit" ""
-	whenM (stageDirect) $ do
+	whenM stageDirect $ do
 		showOutput
 		void $ inRepo $ Git.Command.runBool
 			[ Param "commit"

Command/List.hs

@@ -72,9 +72,9 @@ type RemoteName = String
 type Present = Bool
 
 header :: [(RemoteName, TrustLevel)] -> String
-header remotes = (unlines $ zipWith formatheader [0..] remotes) ++ (pipes (length remotes))
+header remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
   where
-    formatheader n (remotename, trustlevel) = (pipes n) ++ remotename ++ (trust trustlevel)
+    formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
     pipes = flip replicate '|'
     trust UnTrusted = " (untrusted)"
     trust _ = ""

Command/Move.hs

@@ -38,7 +38,7 @@ start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> C
 start to from move file (key, _) = start' to from move (Just file) key
 
 startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
-startKey to from move key = start' to from move Nothing key
+startKey to from move = start' to from move Nothing
 
 start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
 start' to from move afile key = do

Command/PreCommit.hs

@@ -24,7 +24,7 @@ def = [command "pre-commit" paramPaths seek SectionPlumbing
 seek :: [CommandSeek]
 seek =
 	-- fix symlinks to files being committed
-	[ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed $ Command.Fix.start
+	[ whenNotDirect $ withFilesToBeCommitted $ whenAnnexed Command.Fix.start
 	-- inject unlocked files into the annex
 	, whenNotDirect $ withFilesUnlockedToBeCommitted startIndirect
 	-- update direct mode mappings for committed files

Command/RecvKey.hs

@@ -32,7 +32,7 @@ seek = [withKeys start]
 start :: Key -> CommandStart
 start key = ifM (inAnnex key)
 	( error "key is already present in annex"
-	, fieldTransfer Download key $ \_p -> do
+	, fieldTransfer Download key $ \_p ->
 		ifM (getViaTmp key go)
 			( do
 				-- forcibly quit after receiving one key,

Command/Reinject.hs

@@ -34,7 +34,7 @@ start (src:dest:[])
 start _ = error "specify a src file and a dest file"
 
 perform :: FilePath -> FilePath -> (Key, Backend) -> CommandPerform
-perform src _dest (key, backend) = do
+perform src _dest (key, backend) =
 	{- Check the content before accepting it. -}
 	ifM (Command.Fsck.checkKeySizeOr reject key src
 		<&&> Command.Fsck.checkBackendOr reject backend key src)

Command/SendKey.hs

@@ -46,6 +46,6 @@ fieldTransfer direction key a = do
 	ok <- maybe (a $ const noop)
 		(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
 		=<< Fields.getField Fields.remoteUUID
-	if ok
+	liftIO $ if ok
-		then liftIO exitSuccess
+		then exitSuccess
-		else liftIO exitFailure
+		else exitFailure

Command/Status.hs

@@ -238,10 +238,10 @@ transfer_list :: Stat
 transfer_list = stat "transfers in progress" $ nojson $ lift $ do
 	uuidmap <- Remote.remoteMap id
 	ts <- getTransfers
-	if null ts
+	return $ if null ts
-		then return "none"
+		then "none"
-		else return $ multiLine $
+		else multiLine $
-			map (\(t, i) -> line uuidmap t i) $ sort ts
+			map (uncurry $ line uuidmap) $ sort ts
   where
 	line uuidmap t i = unwords
 		[ showLcDirection (transferDirection t) ++ "ing"
@@ -340,7 +340,7 @@ emptyKeyData :: KeyData
 emptyKeyData = KeyData 0 0 0 M.empty
 
 emptyNumCopiesStats :: NumCopiesStats
-emptyNumCopiesStats = NumCopiesStats $ M.empty
+emptyNumCopiesStats = NumCopiesStats M.empty
 
 foldKeys :: [Key] -> KeyData
 foldKeys = foldl' (flip addKey) emptyKeyData

Command/Sync.hs

@@ -86,20 +86,19 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
 	fastest = fromMaybe [] . headMaybe . Remote.byCost
 
 commit :: CommandStart
-commit = next $ next $ do
+commit = next $ next $ ifM isDirect
-	ifM isDirect
+	( do
-		( do
+		void stageDirect
-			void $ stageDirect
+		runcommit []
-			runcommit []
+	, runcommit [Param "-a"]
-		, runcommit [Param "-a"]
+	)
-		)
   where
 	runcommit ps = do
 		showStart "commit" ""
 		showOutput
 		Annex.Branch.commit "update"
 		-- Commit will fail when the tree is clean, so ignore failure.
-		let params = (Param "commit") : ps ++
+		let params = Param "commit" : ps ++
 			[Param "-m", Param "git-annex automatic sync"]
 		_ <- inRepo $ tryIO . Git.Command.runQuiet params
 		return True
@@ -151,12 +150,12 @@ pullRemote remote branch = do
  - were committed (or pushed changes, if this is a bare remote),
  - while the synced/master may have changes that some
  - other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> (Maybe Git.Ref) -> CommandCleanup
+mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
 mergeRemote remote b = case b of
 	Nothing -> do
 		branch <- inRepo Git.Branch.currentUnsafe
-		all id <$> (mapM merge $ branchlist branch)
+		and <$> mapM merge (branchlist branch)
-	Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b))
+	Just _ -> and <$> (mapM merge =<< tomerge (branchlist b))
   where
 	merge = mergeFrom . remoteBranch remote
 	tomerge branches = filterM (changed remote) branches
@@ -221,7 +220,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g
 
 mergeAnnex :: CommandStart
 mergeAnnex = do
-	void $ Annex.Branch.forceUpdate
+	void Annex.Branch.forceUpdate
 	stop
 
 {- Merges from a branch into the current branch. -}
@@ -244,7 +243,7 @@ mergeFrom branch = do
 				mergeDirectCleanup d oldsha newsha
 			_ -> noop
 		return r
-	runmerge a = ifM (a)
+	runmerge a = ifM a
 		( return True
 		, resolveMerge
 		)
@@ -268,7 +267,7 @@ resolveMerge :: Annex Bool
 resolveMerge = do
 	top <- fromRepo Git.repoPath
 	(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
-	merged <- all id <$> mapM resolveMerge' fs
+	merged <- and <$> mapM resolveMerge' fs
 	void $ liftIO cleanup
 
 	(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])
@@ -291,7 +290,7 @@ resolveMerge' u
 		withKey LsFiles.valUs $ \keyUs ->
 			withKey LsFiles.valThem $ \keyThem -> do
 				ifM isDirect
-					( maybe noop (\k -> removeDirect k file) keyUs
+					( maybe noop (`removeDirect` file) keyUs
 					, liftIO $ nukeFile file
 					)
 				Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
@@ -307,14 +306,13 @@ resolveMerge' u
 			makelink keyThem
 			return True
 	file = LsFiles.unmergedFile u
-	issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
+	issymlink select = select (LsFiles.unmergedBlobType u) `elem` [Just SymlinkBlob, Nothing]
-		[Just SymlinkBlob, Nothing]
 	makelink (Just key) = do
 		let dest = mergeFile file key
 		l <- inRepo $ gitAnnexLink dest key
 		replaceFile dest $ makeAnnexLink l
 		stageSymlink dest =<< hashSymlink l
-		whenM (isDirect) $
+		whenM isDirect $
 			toDirect key dest
 	makelink _ = noop
 	withKey select a = do

Command/TransferInfo.hs

@@ -36,7 +36,7 @@ seek = [withWords start]
  -}
 start :: [String] -> CommandStart
 start (k:[]) = do
-	case (file2key k) of
+	case file2key k of
 		Nothing -> error "bad key"
 		(Just key) -> whenM (inAnnex key) $ do
 			file <- Fields.getField Fields.associatedFile

Command/TransferKeys.hs

@@ -41,7 +41,7 @@ seek = [withField readFdOption convertFd $ \readh ->
 
 convertFd :: Maybe String -> Annex (Maybe Handle)
 convertFd Nothing = return Nothing
-convertFd (Just s) = liftIO $ do
+convertFd (Just s) = liftIO $ 
 	case readish s of
 		Nothing -> error "bad fd"
 		Just fd -> Just <$> fdToHandle fd

Command/Unannex.hs

@@ -46,7 +46,7 @@ performIndirect file key = do
 	-- git as a normal non-annexed file, to thinking that the
 	-- file has been unlocked and needs to be re-annexed.
 	(s, reap) <- inRepo $ LsFiles.staged [file]
-	when (not $ null s) $
+	unless (null s) $
 		inRepo $ Git.Command.run
 			[ Param "commit"
 			, Param "-q"

Command/Vicfg.hs

@@ -123,14 +123,14 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
 	settings field desc showvals showdefaults = concat
 		[ desc
 		, concatMap showvals $ sort $ map swap $ M.toList $ field cfg
-		, concatMap (\u -> lcom $ showdefaults u) $ missing field
+		, concatMap (lcom . showdefaults) $ missing field
 		]
 
 	line setting u value =
-		[ com $ "(for " ++ (fromMaybe "" $ M.lookup u descs) ++ ")"
+		[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
 		, unwords [setting, fromUUID u, "=", value]
 		]
-	lcom = map (\l -> if "#" `isPrefixOf` l then l else "#" ++ l)
+	lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
 	missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
 
 {- If there's a parse error, returns a new version of the file,
@@ -139,7 +139,7 @@ parseCfg :: Cfg -> String -> Either String Cfg
 parseCfg curcfg = go [] curcfg . lines
   where
 	go c cfg []
-		| null (catMaybes $ map fst c) = Right cfg
+		| null (mapMaybe fst c) = Right cfg
 		| otherwise = Left $ unlines $
 			badheader ++ concatMap showerr (reverse c)
 	go c cfg (l:ls) = case parse (dropWhile isSpace l) cfg of

Command/WebApp.hs

@@ -55,7 +55,7 @@ start = start' True
 
 start' :: Bool -> Maybe HostName -> CommandStart
 start' allowauto listenhost = do
-	liftIO $ ensureInstalled
+	liftIO ensureInstalled
 	ifM isInitialized ( go , auto )
 	stop
   where
@@ -209,7 +209,7 @@ openBrowser mcmd htmlshim realurl outh errh = do
 			, std_err = maybe Inherit UseHandle errh
 			}
 		exitcode <- waitForProcess pid
-		unless (exitcode == ExitSuccess) $ do
+		unless (exitcode == ExitSuccess) $
 			hPutStrLn (fromMaybe stderr errh) "failed to start web browser"
 
 {- web.browser is a generic git config setting for a web browser program -}

Config/Cost.hs

@@ -65,7 +65,7 @@ costBetween x y
 	| x == y = x
 	| x > y = -- avoid fractions unless needed
 		let mid = y + (x - y) / 2
-		    mid' = fromIntegral ((floor mid) :: Int)
+		    mid' = fromIntegral (floor mid :: Int)
 		in if mid' > y then mid' else mid
 	| otherwise = costBetween y x
 

Config/Files.hs

@@ -34,7 +34,7 @@ modifyAutoStartFile func = do
 	when (dirs' /= dirs) $ do
 		f <- autoStartFile
 		createDirectoryIfMissing True (parentDir f)
-		viaTmp writeFile f $ unlines $ dirs'
+		viaTmp writeFile f $ unlines dirs'
 
 {- Adds a directory to the autostart file. If the directory is already
  - present, it's moved to the top, so it will be used as the default