hlint tweaks

Did all sources except Remotes/* and Command/*

Backend.hs

@@ -19,6 +19,7 @@ import Control.Monad.State (liftIO, when)
 import System.IO.Error (try)
 import System.FilePath
 import System.Posix.Files
+import Data.Maybe
 
 import Locations
 import qualified Git
@@ -33,10 +34,7 @@ import qualified Backend.WORM
 import qualified Backend.SHA
 
 list :: [Backend Annex]
-list = concat 
+list = Backend.WORM.backends ++ Backend.SHA.backends
-	[ Backend.WORM.backends
-	, Backend.SHA.backends
-	]
 
 {- List of backends in the order to try them when storing a new key. -}
 orderedList :: Annex [Backend Annex]
@@ -54,7 +52,7 @@ orderedList = do
 		handle Nothing s = return s
 		handle (Just "") s = return s
 		handle (Just name) s = do
-			let l' = (lookupBackendName name):s
+			let l' = lookupBackendName name : s
 			Annex.changeState $ \state -> state { Annex.backends = l' }
 			return l'
 		getstandard = do
@@ -119,7 +117,7 @@ chooseBackends fs = do
 
 {- Looks up a backend by name. May fail if unknown. -}
 lookupBackendName :: String -> Backend Annex
-lookupBackendName s = maybe unknown id $ maybeLookupBackendName s
+lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
 	where
 		unknown = error $ "unknown backend " ++ s
 maybeLookupBackendName :: String -> Maybe (Backend Annex)

Backend/SHA.hs

@@ -114,7 +114,7 @@ checkKeyChecksum size key = do
 	fast <- Annex.getState Annex.fast
 	let file = gitAnnexLocation g key
 	present <- liftIO $ doesFileExist file
-	if (not present || fast)
+	if not present || fast
 		then return True
 		else do
 			s <- shaN size file

Backend/WORM.hs

@@ -35,7 +35,7 @@ backend = Types.Backend.Backend {
 keyValue :: FilePath -> Annex (Maybe Key)
 keyValue file = do
 	stat <- liftIO $ getFileStatus file
-	return $ Just $ Key {
+	return $ Just Key {
 		keyName = takeFileName file,
 		keyBackendName = name backend,
 		keySize = Just $ fromIntegral $ fileSize stat,

Branch.hs

@@ -87,7 +87,7 @@ withIndex' bootstrapping a = do
 
 	e <- liftIO $ doesFileExist f
 	unless e $ do
-		unless bootstrapping $ create
+		unless bootstrapping create
 		liftIO $ createDirectoryIfMissing True $ takeDirectory f
 		liftIO $ unless bootstrapping $ genIndex g
 
@@ -187,7 +187,7 @@ updateRef ref
 			Param (name++".."++ref),
 			Params "--oneline -n1"
 			]
-		if (null diffs)
+		if null diffs
 			then return Nothing
 			else do
 				showSideAction $ "merging " ++ shortref ref ++ " into " ++ name ++ "..."
@@ -305,7 +305,7 @@ getJournalFile file = do
 
 {- List of journal files. -}
 getJournalFiles :: Annex [FilePath]
-getJournalFiles = getJournalFilesRaw >>= return . map fileJournal
+getJournalFiles = fmap (map fileJournal) getJournalFilesRaw
 
 getJournalFilesRaw :: Annex [FilePath]
 getJournalFilesRaw = do

CmdLine.hs

@@ -39,14 +39,13 @@ dispatch args cmds options header gitrepo = do
  - list of actions to be run in the Annex monad. -}
 parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool]
 parseCmd argv header cmds options = do
-	(flags, params) <- liftIO $ getopt
+	(flags, params) <- liftIO getopt
 	when (null params) $ error $ "missing command" ++ usagemsg
 	case lookupCmd (head params) of
 		[] -> error $ "unknown command" ++ usagemsg
 		[command] -> do
 			_ <- sequence flags
-			when (cmdusesrepo command) $
+			when (cmdusesrepo command) checkVersion
-				checkVersion
 			prepCommand command (drop 1 params)
 		_ -> error "internal error: multiple matching commands"
 	where
@@ -78,9 +77,9 @@ usage header cmds options =
  - (but explicitly thrown errors terminate the whole command).
  -}
 tryRun :: Annex.AnnexState -> [Annex Bool] -> IO ()
-tryRun state actions = tryRun' state 0 actions
+tryRun = tryRun' 0
-tryRun' :: Annex.AnnexState -> Integer -> [Annex Bool] -> IO ()
+tryRun' :: Integer -> Annex.AnnexState -> [Annex Bool] -> IO ()
-tryRun' state errnum (a:as) = do
+tryRun' errnum state (a:as) = do
 	result <- try $ Annex.run state $ do
 		AnnexQueue.flushWhenFull
 		a
@@ -89,11 +88,10 @@ tryRun' state errnum (a:as) = do
 			Annex.eval state $ do
 				showEndFail
 				showErr err
-			tryRun' state (errnum + 1) as
+			tryRun' (errnum + 1) state as
-		Right (True,state') -> tryRun' state' errnum as
+		Right (True,state') -> tryRun' errnum state' as
-		Right (False,state') -> tryRun' state' (errnum + 1) as
+		Right (False,state') -> tryRun' (errnum + 1) state' as
-tryRun' _ errnum [] = do
+tryRun' errnum _ [] = when (errnum > 0) $ error $ show errnum ++ " failed"
-	when (errnum > 0) $ error $ show errnum ++ " failed"
 
 {- Actions to perform each time ran. -}
 startup :: Annex Bool
@@ -105,5 +103,5 @@ startup = do
 shutdown :: Annex Bool
 shutdown = do
 	saveState
-	liftIO $ Git.reap
+	liftIO Git.reap
 	return True

Command.hs

@@ -115,7 +115,7 @@ isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
 notBareRepo :: Annex a -> Annex a
 notBareRepo a = do
 	g <- Annex.gitRepo
-	when (Git.repoIsLocalBare g) $ do
+	when (Git.repoIsLocalBare g) $
 		error "You cannot run this subcommand in a bare repository."
 	a
 
@@ -175,9 +175,9 @@ withFilesUnlocked' typechanged a params = do
 	unlockedfiles' <- filterFiles unlockedfiles
 	backendPairs a unlockedfiles'
 withKeys :: CommandSeekKeys
-withKeys a params = return $ map a $ map parse params
+withKeys a params = return $ map (a . parse) params
 	where
-		parse p = maybe (error "bad key") id $ readKey p
+		parse p = fromMaybe (error "bad key") $ readKey p
 withTempFile :: CommandSeekStrings
 withTempFile a params = return $ map a params
 withNothing :: CommandSeekNothing

Content.hs

@@ -57,8 +57,8 @@ inAnnex key = do
 calcGitLink :: FilePath -> Key -> Annex FilePath
 calcGitLink file key = do
 	g <- Annex.gitRepo
-	cwd <- liftIO $ getCurrentDirectory
+	cwd <- liftIO getCurrentDirectory
-	let absfile = maybe whoops id $ absNormPath cwd file
+	let absfile = fromMaybe whoops $ absNormPath cwd file
 	return $ relPathDirToFile (parentDir absfile) 
 			(Git.workTree g) </> ".git" </> annexLocation key
 	where
@@ -94,15 +94,19 @@ getViaTmp key action = do
 
 	getViaTmpUnchecked key action
 
+prepTmp :: Key -> Annex FilePath
+prepTmp key = do
+	g <- Annex.gitRepo
+	let tmp = gitAnnexTmpLocation g key
+	liftIO $ createDirectoryIfMissing True (parentDir tmp)
+	return tmp
+
 {- Like getViaTmp, but does not check that there is enough disk space
  - for the incoming key. For use when the key content is already on disk
  - and not being copied into place. -}
 getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
 getViaTmpUnchecked key action = do
-	g <- Annex.gitRepo
+	tmp <- prepTmp key
-	let tmp = gitAnnexTmpLocation g key
-
-	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	success <- action tmp
 	if success
 		then do
@@ -117,9 +121,7 @@ getViaTmpUnchecked key action = do
 {- Creates a temp file, runs an action on it, and cleans up the temp file. -}
 withTmp :: Key -> (FilePath -> Annex a) -> Annex a
 withTmp key action = do
-	g <- Annex.gitRepo
+	tmp <- prepTmp key
-	let tmp = gitAnnexTmpLocation g key
-	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	res <- action tmp
 	liftIO $ whenM (doesFileExist tmp) $ liftIO $ removeFile tmp
 	return res
@@ -133,20 +135,18 @@ checkDiskSpace' :: Integer -> Key -> Annex ()
 checkDiskSpace' adjustment key = do
 	g <- Annex.gitRepo
 	r <- getConfig g "diskreserve" ""
-	let reserve = maybe megabyte id $ readSize dataUnits r
+	let reserve = fromMaybe megabyte $ readSize dataUnits r
 	stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
 	case (stats, keySize key) of
 		(Nothing, _) -> return ()
 		(_, Nothing) -> return ()
 		(Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) ->
-			if (need + reserve > have + adjustment)
+			when (need + reserve > have + adjustment) $
-				then needmorespace (need + reserve - have - adjustment)
+				needmorespace (need + reserve - have - adjustment)
-				else return ()
 	where
 		megabyte :: Integer
 		megabyte = 1000000
-		needmorespace n = do
+		needmorespace n = unlessM (Annex.getState Annex.force) $
-			unlessM (Annex.getState Annex.force) $
 			error $ "not enough free space, need " ++ 
 				roughSize storageUnits True n ++
 				" more (use --force to override this check or adjust annex.diskreserve)"
@@ -200,24 +200,23 @@ moveAnnex key src = do
 			preventWrite dest
 			preventWrite dir
 
-{- Removes a key's file from .git/annex/objects/ -}
+withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
-removeAnnex :: Key -> Annex ()
+withObjectLoc key a = do
-removeAnnex key = do
 	g <- Annex.gitRepo
 	let file = gitAnnexLocation g key
 	let dir = parentDir file
-	liftIO $ do
+	a (dir, file)
+
+{- Removes a key's file from .git/annex/objects/ -}
+removeAnnex :: Key -> Annex ()
+removeAnnex key = withObjectLoc key $ \(dir, file) -> liftIO $ do
 	allowWrite dir
 	removeFile file
 	removeDirectory dir
 
 {- Moves a key's file out of .git/annex/objects/ -}
 fromAnnex :: Key -> FilePath -> Annex ()
-fromAnnex key dest = do
+fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
-	g <- Annex.gitRepo
-	let file = gitAnnexLocation g key
-	let dir = parentDir file
-	liftIO $ do
 	allowWrite dir
 	allowWrite file
 	renameFile file dest
@@ -246,7 +245,7 @@ getKeysPresent = do
 getKeysPresent' :: FilePath -> Annex [Key]
 getKeysPresent' dir = do
 	exists <- liftIO $ doesDirectoryExist dir
-	if (not exists)
+	if not exists
 		then return []
 		else liftIO $ do
 			-- 2 levels of hashing
@@ -254,7 +253,7 @@ getKeysPresent' dir = do
 			levelb <- mapM dirContents levela
 			contents <- mapM dirContents (concat levelb)
 			files <- filterM present (concat contents)
-			return $ catMaybes $ map (fileKey . takeFileName) files
+			return $ mapMaybe (fileKey . takeFileName) files
 	where
 		present d = do
 			result <- try $

Crypto.hs

@@ -33,6 +33,7 @@ import Data.Digest.Pure.SHA
 import System.Cmd.Utils
 import Data.String.Utils
 import Data.List
+import Data.Maybe
 import System.IO
 import System.Posix.IO
 import System.Posix.Types
@@ -125,11 +126,11 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 	return $ EncryptedCipher encipher (KeyIds ks')
 	where
 		encrypt = [ Params "--encrypt" ]
-		recipients l = 
+		recipients l = force_recipients :
+			concatMap (\k -> [Param "--recipient", Param k]) l
 		-- Force gpg to only encrypt to the specified
 		-- recipients, not configured defaults.
-			[ Params "--no-encrypt-to --no-default-recipient"] ++
+		force_recipients = Params "--no-encrypt-to --no-default-recipient"
-			(concat $ map (\k -> [Param "--recipient", Param k]) l)
 
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
@@ -152,24 +153,24 @@ encryptKey c k =
 
 {- Runs an action, passing it a handle from which it can 
  - stream encrypted content. -}
-withEncryptedHandle :: Cipher -> (IO L.ByteString) -> (Handle -> IO a) -> IO a
+withEncryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
 withEncryptedHandle = gpgCipherHandle [Params "--symmetric --force-mdc"]
 
 {- Runs an action, passing it a handle from which it can
  - stream decrypted content. -}
-withDecryptedHandle :: Cipher -> (IO L.ByteString) -> (Handle -> IO a) -> IO a
+withDecryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
 withDecryptedHandle = gpgCipherHandle [Param "--decrypt"]
 
 {- Streams encrypted content to an action. -}
-withEncryptedContent :: Cipher -> (IO L.ByteString) -> (L.ByteString -> IO a) -> IO a
+withEncryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 withEncryptedContent = pass withEncryptedHandle
 
 {- Streams decrypted content to an action. -}
-withDecryptedContent :: Cipher -> (IO L.ByteString) -> (L.ByteString -> IO a) -> IO a
+withDecryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 withDecryptedContent = pass withDecryptedHandle
 
-pass :: (Cipher -> (IO L.ByteString) -> (Handle -> IO a) -> IO a) 
+pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a) 
-      -> Cipher -> (IO L.ByteString) -> (L.ByteString -> IO a) -> IO a
+      -> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 pass to c i a = to c i $ \h -> a =<< L.hGetContents h
 
 gpgParams :: [CommandParam] -> IO [String]
@@ -202,7 +203,7 @@ gpgPipeStrict params input = do
  -
  - Note that to avoid deadlock with the cleanup stage,
  - the action must fully consume gpg's input before returning. -}
-gpgCipherHandle :: [CommandParam] -> Cipher -> (IO L.ByteString) -> (Handle -> IO a) -> IO a
+gpgCipherHandle :: [CommandParam] -> Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
 gpgCipherHandle params c a b = do
 	-- pipe the passphrase into gpg on a fd
 	(frompipe, topipe) <- createPipe
@@ -235,10 +236,10 @@ configKeyIds c = do
 	where
 		parseWithColons s = map keyIdField $ filter pubKey $ lines s
 		pubKey = isPrefixOf "pub:"
-		keyIdField s = (split ":" s) !! 4
+		keyIdField s = split ":" s !! 4
 
 configGet :: RemoteConfig -> String -> String
-configGet c key = maybe missing id $ M.lookup key c
+configGet c key = fromMaybe missing $ M.lookup key c
 	where missing = error $ "missing " ++ key ++ " in remote config"
 
 hmacWithCipher :: Cipher -> String -> String

Git.hs

@@ -69,11 +69,10 @@ import System.Posix.User
 import System.Posix.Process
 import System.Path
 import System.Cmd.Utils
-import IO (bracket_)
+import IO (bracket_, try)
 import Data.String.Utils
 import System.IO
-import IO (try)
+import qualified Data.Map as M hiding (map, split)
-import qualified Data.Map as Map hiding (map, split)
 import Network.URI
 import Data.Maybe
 import Data.Char
@@ -93,7 +92,7 @@ data RepoLocation = Dir FilePath | Url URI | Unknown
 
 data Repo = Repo {
 	location :: RepoLocation,
-	config :: Map.Map String String,
+	config :: M.Map String String,
 	remotes :: [Repo],
 	-- remoteName holds the name used for this repo in remotes
 	remoteName :: Maybe String 
@@ -103,7 +102,7 @@ newFrom :: RepoLocation -> Repo
 newFrom l = 
 	Repo {
 		location = l,
-		config = Map.empty,
+		config = M.empty,
 		remotes = [],
 		remoteName = Nothing
 	}
@@ -140,7 +139,7 @@ repoFromUrl url
 	| startswith "file://" url = repoFromAbsPath $ uriPath u
 	| otherwise = return $ newFrom $ Url u
 		where
-			u = maybe bad id $ parseURI url
+			u = fromMaybe bad $ parseURI url
 			bad = error $ "bad url " ++ url
 
 {- Creates a repo that has an unknown location. -}
@@ -208,7 +207,7 @@ repoIsSsh Repo { location = Url url }
 repoIsSsh _ = False
 
 configAvail ::Repo -> Bool
-configAvail Repo { config = c } = c /= Map.empty
+configAvail Repo { config = c } = c /= M.empty
 
 repoIsLocalBare :: Repo -> Bool
 repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r
@@ -228,7 +227,7 @@ assertUrl repo action =
 				" not supported"
 
 configBare :: Repo -> Bool
-configBare repo = maybe unknown configTrue $ Map.lookup "core.bare" $ config repo
+configBare repo = maybe unknown configTrue $ M.lookup "core.bare" $ config repo
 	where
 		unknown = error $ "it is not known if git repo " ++
 			repoDescribe repo ++
@@ -272,14 +271,14 @@ workTreeFile repo@(Repo { location = Dir d }) file = do
 	let file' = absfile cwd
 	unless (inrepo file') $
 		error $ file ++ " is not located inside git repository " ++ absrepo
-	if (inrepo $ addTrailingPathSeparator cwd)
+	if inrepo $ addTrailingPathSeparator cwd
 		then return $ relPathDirToFile cwd file'
 		else return $ drop (length absrepo) file'
 	where
 		-- normalize both repo and file, so that repo
 		-- will be substring of file
 		absrepo = maybe bad addTrailingPathSeparator $ absNormPath "/" d
-		absfile c = maybe file id $ secureAbsNormPath c file
+		absfile c = fromMaybe file $ secureAbsNormPath c file
 		inrepo f = absrepo `isPrefixOf` f
 		bad = error $ "bad repo" ++ repoDescribe repo
 workTreeFile repo _ = assertLocal repo $ error "internal"
@@ -303,7 +302,7 @@ uriRegName' a = fixup $ uriRegName a
 			| rest !! len == ']' = take len rest
 			| otherwise = x
 			where
-				len  = (length rest) - 1
+				len  = length rest - 1
 		fixup x = x
 
 {- Hostname of an URL repo. -}
@@ -348,7 +347,7 @@ gitCommandLine repo _ = assertLocal repo $ error "internal"
 {- Runs git in the specified repo. -}
 runBool :: Repo -> String -> [CommandParam] -> IO Bool
 runBool repo subcommand params = assertLocal repo $
-	boolSystem "git" (gitCommandLine repo ((Param subcommand):params))
+	boolSystem "git" $ gitCommandLine repo $ Param subcommand : params
 
 {- Runs git in the specified repo, throwing an error if it fails. -}
 run :: Repo -> String -> [CommandParam] -> IO ()
@@ -471,13 +470,13 @@ hConfigRead repo h = do
  - can be updated inrementally. -}
 configStore :: Repo -> String -> IO Repo
 configStore repo s = do
-	let repo' = repo { config = Map.union (configParse s) (config repo) }
+	let repo' = repo { config = configParse s `M.union` config repo }
 	rs <- configRemotes repo'
 	return $ repo' { remotes = rs }
 
 {- Parses git config --list output into a config map. -}
-configParse :: String -> Map.Map String String
+configParse :: String -> M.Map String String
-configParse s = Map.fromList $ map pair $ lines s
+configParse s = M.fromList $ map pair $ lines s
 	where
 		pair l = (key l, val l)
 		key l = head $ keyval l
@@ -489,8 +488,8 @@ configParse s = Map.fromList $ map pair $ lines s
 configRemotes :: Repo -> IO [Repo]
 configRemotes repo = mapM construct remotepairs
 	where
-		remotepairs = Map.toList $ filterremotes $ config repo
+		remotepairs = M.toList $ filterremotes $ config repo
-		filterremotes = Map.filterWithKey (\k _ -> isremote k)
+		filterremotes = M.filterWithKey (\k _ -> isremote k)
 		isremote k = startswith "remote." k && endswith ".url" k
 		construct (k,v) = do
 			r <- gen v
@@ -499,15 +498,15 @@ configRemotes repo = mapM construct remotepairs
 			| isURI v = repoFromUrl v
 			| otherwise = repoFromRemotePath v repo
 		-- git remotes can be written scp style -- [user@]host:dir
-		scpstyle v = ":" `isInfixOf` v && (not $ "//" `isInfixOf` v)
+		scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v)
 		scptourl v = "ssh://" ++ host ++ slash dir
 			where
 				bits = split ":" v
-				host = bits !! 0
+				host = head bits
 				dir = join ":" $ drop 1 bits
 				slash d	| d == "" = "/~/" ++ dir
-					| d !! 0 == '/' = dir
+					| head d == '/' = dir
-					| d !! 0 == '~' = '/':dir
+					| head d == '~' = '/':dir
 					| otherwise = "/~/" ++ dir
 
 {- Checks if a string from git config is a true value. -}
@@ -517,11 +516,11 @@ configTrue s = map toLower s == "true"
 {- Returns a single git config setting, or a default value if not set. -}
 configGet :: Repo -> String -> String -> String
 configGet repo key defaultValue = 
-	Map.findWithDefault defaultValue key (config repo)
+	M.findWithDefault defaultValue key (config repo)
 
 {- Access to raw config Map -}
-configMap :: Repo -> Map.Map String String
+configMap :: Repo -> M.Map String String
-configMap repo = config repo
+configMap = config
 
 {- Efficiently looks up a gitattributes value for each file in a list. -}
 checkAttr :: Repo -> String -> [FilePath] -> IO [(FilePath, String)]
@@ -680,8 +679,8 @@ seekUp :: (FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath)
 seekUp want dir = do
 	ok <- want dir
 	if ok
-		then return (Just dir)
+		then return $ Just dir
-		else case (parentDir dir) of
+		else case parentDir dir of
 			"" -> return Nothing
 			d -> seekUp want d
 

Git/LsFiles.hs

@@ -21,7 +21,7 @@ import Utility
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: Repo -> [FilePath] -> IO [FilePath]
 inRepo repo l = pipeNullSplit repo $
-	[Params "ls-files --cached -z --"] ++ map File l
+	Params "ls-files --cached -z --" : map File l
 
 {- Scans for files at the specified locations that are not checked into
  - git. -}
@@ -44,12 +44,12 @@ staged' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
 staged' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 	where
 		start = [Params "diff --cached --name-only -z"]
-		end = [Param "--"] ++ map File l
+		end = Param "--" : map File l
 
 {- Returns a list of files that have unstaged changes. -}
 changedUnstaged :: Repo -> [FilePath] -> IO [FilePath]
 changedUnstaged repo l = pipeNullSplit repo $
-	[Params "diff --name-only -z --"] ++ map File l
+	Params "diff --name-only -z --" : map File l
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
@@ -65,4 +65,4 @@ typeChanged' :: Repo -> [FilePath] -> [CommandParam] -> IO [FilePath]
 typeChanged' repo l middle = pipeNullSplit repo $ start ++ middle ++ end
 	where
 		start = [Params "diff --name-only --diff-filter=T -z"]
-		end = [Param "--"] ++ map File l
+		end = Param "--" : map File l

Git/Queue.hs

@@ -18,7 +18,7 @@ import qualified Data.Map as M
 import System.IO
 import System.Cmd.Utils
 import Data.String.Utils
-import Control.Monad (unless, forM_)
+import Control.Monad (forM_)
 import Utility
 
 import Git
@@ -61,7 +61,7 @@ add (Queue n m) subcommand params files = Queue (n + 1) m'
 		-- can be a lot of files per item. So, optimise adding
 		-- files.
 		m' = M.insertWith' const action fs m
-		fs = files ++ (M.findWithDefault [] action m)
+		fs = files ++ M.findWithDefault [] action m
 
 {- Number of items in a queue. -}
 size :: Queue -> Int

Git/UnionMerge.hs

@@ -91,5 +91,5 @@ mergeFile g (info, file) = case filter (/= nullsha) [asha, bsha] of
 		return $ Just $ update_index_line sha file
 	where
 		[_colonamode, _bmode, asha, bsha, _status] = words info
-		nullsha = take shaSize $ repeat '0'
+		nullsha = replicate shaSize '0'
 		unionmerge = unlines . nub . lines

LocationLog.hs

@@ -49,8 +49,7 @@ keyLocations key = currentLog $ logFile key
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}
 loggedKeys :: Annex [Key]
-loggedKeys =
+loggedKeys = return . mapMaybe (logFileKey . takeFileName) =<< Branch.files
-	return . catMaybes . map (logFileKey . takeFileName) =<< Branch.files
 
 {- The filename of the log file for a given key. -}
 logFile :: Key -> String

Locations.hs

@@ -52,7 +52,7 @@ import qualified Git
 {- The directory git annex uses for local state, relative to the .git
  - directory -}
 annexDir :: FilePath
-annexDir = addTrailingPathSeparator $ "annex"
+annexDir = addTrailingPathSeparator "annex"
 
 {- The directory git annex uses for locally available object content,
  - relative to the .git directory -}

Messages.hs

@@ -37,7 +37,7 @@ showProgress :: Annex ()
 showProgress = verbose $ liftIO $ putStr "\n"
 
 showLongNote :: String -> Annex ()
-showLongNote s = verbose $ liftIO $ putStr $ "\n" ++ indent s
+showLongNote s = verbose $ liftIO $ putStr $ '\n' : indent s
 
 showEndOk :: Annex ()
 showEndOk = verbose $ liftIO $ putStrLn "ok"

PresenceLog.hs

@@ -94,7 +94,7 @@ writeLog file ls = Branch.change file (unlines $ map show ls)
 {- Generates a new LogLine with the current date. -}
 logNow :: LogStatus -> String -> Annex LogLine
 logNow s i = do
-	now <- liftIO $ getPOSIXTime
+	now <- liftIO getPOSIXTime
 	return $ LogLine now s i
 
 {- Reads a log and returns only the info that is still in effect. -}
@@ -112,7 +112,7 @@ type LogMap = Map.Map String LogLine
 {- Compacts a set of logs, returning a subset that contains the current
  - status. -}
 compactLog :: [LogLine] -> [LogLine]
-compactLog ls = compactLog' Map.empty ls
+compactLog = compactLog' Map.empty
 compactLog' :: LogMap -> [LogLine] -> [LogLine]
 compactLog' m [] = Map.elems m
 compactLog' m (l:ls) = compactLog' (mapLog m l) ls

Remote.hs

@@ -33,6 +33,7 @@ import Control.Monad (filterM, liftM2)
 import Data.List
 import qualified Data.Map as M
 import Data.String.Utils
+import Data.Maybe
 
 import Types
 import Types.Remote
@@ -97,7 +98,7 @@ byName' "" = return $ Left "no remote specified"
 byName' n = do
 	allremotes <- genList
 	let match = filter matching allremotes
-	if (null match)
+	if null match
 		then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
 		else return $ Right $ head match
 	where
@@ -110,7 +111,7 @@ nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
 nameToUUID n = do
 	res <- byName' n
 	case res of
-		Left e -> return . (maybe (error e) id) =<< byDescription
+		Left e -> return . fromMaybe (error e) =<< byDescription
 		Right r -> return $ uuid r
 	where
 		byDescription = return . M.lookup n . invertMap =<< uuidMap
@@ -122,7 +123,7 @@ prettyPrintUUIDs :: [UUID] -> Annex String
 prettyPrintUUIDs uuids = do
 	here <- getUUID =<< Annex.gitRepo
 	-- Show descriptions from the uuid log, falling back to remote names,
-	-- as some remotes may not be in the uuid log.
+	-- as some remotes may not be in the uuid log
 	m <- liftM2 M.union uuidMap $
 		return . M.fromList . map (\r -> (uuid r, name r)) =<< genList
 	return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids

RemoteLog.hs

@@ -36,7 +36,7 @@ configSet u c = do
 	Branch.change remoteLog $ unlines $ sort $
 		map toline $ M.toList $ M.insert u c m
 	where
-		toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
+		toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
@@ -44,14 +44,14 @@ readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
 
 remoteLogParse :: String -> M.Map UUID RemoteConfig
 remoteLogParse s =
-	M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
+	M.fromList $ mapMaybe parseline $ filter (not . null) $ lines s
 	where
 		parseline l
 			| length w > 2 = Just (u, c)
 			| otherwise = Nothing
 			where
 				w = words l
-				u = w !! 0
+				u = head w
 				c = keyValToConfig $ tail w
 
 {- Given Strings like "key=value", generates a RemoteConfig. -}
@@ -90,8 +90,8 @@ configUnEscape = unescape
 				r = drop (length num) s
 				rest = drop 1 r
 				ok = not (null num) && 
-					not (null r) && r !! 0 == ';'
+					not (null r) && head r == ';'
 
 {- for quickcheck -}
 prop_idempotent_configEscape :: String -> Bool
-prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s)
+prop_idempotent_configEscape s = s == (configUnEscape . configEscape) s

TestConfig.hs

@@ -45,7 +45,7 @@ writeSysConfig config = writeFile "SysConfig.hs" body
 
 runTests :: [TestCase] -> IO [Config]
 runTests [] = return []
-runTests ((TestCase tname t):ts) = do
+runTests (TestCase tname t : ts) = do
 	testStart tname
 	c <- t
 	testEnd c
@@ -62,7 +62,7 @@ requireCmd k cmdline = do
 		handle r = do
 			testEnd r
 			error $ "** the " ++ c ++ " command is required"
-		c = (words cmdline) !! 0
+		c = head $ words cmdline
 
 {- Checks if a command is available by running a command line. -}
 testCmd :: ConfigKey -> String -> Test
@@ -74,7 +74,7 @@ testCmd k cmdline = do
  - turn. The Config is set to the first one found. -}
 selectCmd :: ConfigKey -> [String] -> String -> Test
 selectCmd k = searchCmd
-		(\match -> return $ Config k $ StringConfig match)
+		(return . Config k . StringConfig)
 		(\cmds -> do
 			testEnd $ Config k $ BoolConfig False
 			error $ "* need one of these commands, but none are available: " ++ show cmds
@@ -82,7 +82,7 @@ selectCmd k = searchCmd
 
 maybeSelectCmd :: ConfigKey -> [String] -> String -> Test
 maybeSelectCmd k = searchCmd
-		(\match -> return $ Config k $ MaybeStringConfig $ Just match)
+		(return . Config k . MaybeStringConfig . Just)
 		(\_ -> return $ Config k $ MaybeStringConfig Nothing)
 
 searchCmd :: (String -> Test) -> ([String] -> Test) -> [String] -> String -> Test
@@ -91,7 +91,7 @@ searchCmd success failure cmds param = search cmds
 		search [] = failure cmds
 		search (c:cs) = do
 			ret <- system $ quiet c ++ " " ++ param
-			if (ret == ExitSuccess)
+			if ret == ExitSuccess
 				then success c
 				else search cs
 
@@ -104,8 +104,11 @@ testStart s = do
 	hFlush stdout
 
 testEnd :: Config -> IO ()
-testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
+testEnd (Config _ (BoolConfig True)) = status "yes"
-testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
+testEnd (Config _ (BoolConfig False)) = status "no"
-testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
+testEnd (Config _ (StringConfig s)) = status s
-testEnd (Config _ (MaybeStringConfig (Just s))) = putStrLn $ " " ++ s
+testEnd (Config _ (MaybeStringConfig (Just s))) = status s
-testEnd (Config _ (MaybeStringConfig Nothing)) = putStrLn $ " not available"
+testEnd (Config _ (MaybeStringConfig Nothing)) = status "not available"
+
+status :: String -> IO ()
+status s = putStrLn $ ' ':s

Types/Key.hs

@@ -48,7 +48,7 @@ instance Show Key where
 			"" +++ y = y
 			x +++ "" = x
 			x +++ y = x ++ fieldSep:y
-			c ?: (Just v) = c:(show v)
+			c ?: (Just v) = c : show v
 			_ ?: _ = ""
 
 readKey :: String -> Maybe Key
@@ -73,4 +73,4 @@ readKey s = if key == Just stubKey then Nothing else key
 		addfield _ _ _ = Nothing
 
 prop_idempotent_key_read_show :: Key -> Bool
-prop_idempotent_key_read_show k = Just k == (readKey $ show k)
+prop_idempotent_key_read_show k = Just k == (readKey . show) k

Types/Remote.hs

@@ -11,6 +11,7 @@ module Types.Remote where
 
 import Control.Exception
 import Data.Map as M
+import Data.Ord
 
 import qualified Git
 import Types.Key
@@ -62,4 +63,4 @@ instance Eq (Remote a) where
 
 -- order remotes by cost
 instance Ord (Remote a) where
-	compare x y = compare (cost x) (cost y)
+	compare = comparing cost

UUID.hs

@@ -49,7 +49,7 @@ genUUID :: IO UUID
 genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
 	where
 		command = SysConfig.uuid
-		params = if (command == "uuid")
+		params = if command == "uuid"
 			-- request a random uuid be generated
 			then ["-m"]
 			-- uuidgen generates random uuid by default
@@ -82,7 +82,7 @@ prepUUID :: Annex ()
 prepUUID = do
 	u <- getUUID =<< Annex.gitRepo
 	when ("" == u) $ do
-		uuid <- liftIO $ genUUID
+		uuid <- liftIO genUUID
 		setConfig configkey uuid
 
 {- Records a description for a uuid in the uuidLog. -}

Upgrade/V0.hs

@@ -48,7 +48,7 @@ lookupFile0 = Upgrade.V1.lookupFile1
 getKeysPresent0 :: FilePath -> Annex [Key]
 getKeysPresent0 dir = do
 	exists <- liftIO $ doesDirectoryExist dir
-	if (not exists)
+	if not exists
 		then return []
 		else do
 			contents <- liftIO $ getDirectoryContents dir

Upgrade/V1.hs

@@ -94,7 +94,7 @@ updateSymlinks = do
 	showNote "updating symlinks..."
 	g <- Annex.gitRepo
 	files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
-	forM_ files $ fixlink
+	forM_ files fixlink
 	where
 		fixlink f = do
 			r <- lookupFile1 f
@@ -119,7 +119,7 @@ moveLocationLogs = do
 				if exists
 					then do
 						contents <- liftIO $ getDirectoryContents dir
-						return $ catMaybes $ map oldlog2key contents
+						return $ mapMaybe oldlog2key contents
 					else return []
 			move (l, k) = do
 				g <- Annex.gitRepo
@@ -196,11 +196,8 @@ lookupFile1 file = do
 		Left _ -> return Nothing
 		Right l -> makekey l
 	where
-		getsymlink = do
+		getsymlink = return . takeFileName =<< readSymbolicLink file
-			l <- readSymbolicLink file
+		makekey l = case maybeLookupBackendName bname of
-			return $ takeFileName l
-		makekey l = do
-			case maybeLookupBackendName bname of
 			Nothing -> do
 				unless (null kname || null bname ||
 				        not (isLinkToAnnex l)) $
@@ -221,7 +218,7 @@ getKeyFilesPresent1  = do
 getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
 getKeyFilesPresent1' dir = do
 	exists <- liftIO $ doesDirectoryExist dir
-	if (not exists)
+	if not exists
 		then return []
 		else do
 			dirs <- liftIO $ getDirectoryContents dir

Upgrade/V2.hs

@@ -10,7 +10,7 @@ module Upgrade.V2 where
 import System.Directory
 import System.FilePath
 import Control.Monad.State (unless, when, liftIO)
-import List
+import Data.List
 import Data.Maybe
 
 import Types.Key
@@ -61,7 +61,7 @@ upgrade = do
 		Git.run g "rm" [Param "-r", Param "-f", Param "-q", File (olddir g)]
 		unless bare $ gitAttributesUnWrite g
 
-	unless bare $ push
+	unless bare push
 
 	return True
 
@@ -70,11 +70,11 @@ locationLogs repo = liftIO $ do
 	levela <- dirContents dir
 	levelb <- mapM tryDirContents levela
 	files <- mapM tryDirContents (concat levelb)
-	return $ catMaybes $ map islogfile (concat files)
+	return $ mapMaybe islogfile (concat files)
 	where
 		tryDirContents d = catch (dirContents d) (return . const [])
 		dir = gitStateDir repo
-		islogfile f = maybe Nothing (\k -> Just $ (k, f)) $
+		islogfile f = maybe Nothing (\k -> Just (k, f)) $
 				logFileKey $ takeFileName f
 
 inject :: FilePath -> FilePath -> Annex ()
@@ -131,10 +131,10 @@ gitAttributesUnWrite repo = do
 	whenM (doesFileExist attributes) $ do
 		c <- readFileStrict attributes
 		liftIO $ viaTmp writeFile attributes $ unlines $
-			filter (\l -> not $ l `elem` attrLines) $ lines c
+			filter (`notElem` attrLines) $ lines c
 		Git.run repo "add" [File attributes]
 
 stateDir :: FilePath
-stateDir = addTrailingPathSeparator $ ".git-annex"
+stateDir = addTrailingPathSeparator ".git-annex"
 gitStateDir :: Git.Repo -> FilePath
 gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir

Utility.hs

@@ -141,9 +141,9 @@ shellUnEscape s = word : shellUnEscape rest
 
 {- For quickcheck. -}
 prop_idempotent_shellEscape :: String -> Bool
-prop_idempotent_shellEscape s = [s] == (shellUnEscape $ shellEscape s)
+prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
 prop_idempotent_shellEscape_multiword :: [String] -> Bool
-prop_idempotent_shellEscape_multiword s = s == (shellUnEscape $ unwords $ map shellEscape s)
+prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}

Version.hs

@@ -43,8 +43,7 @@ checkVersion :: Annex ()
 checkVersion = getVersion >>= handle
 	where
 		handle Nothing = error "First run: git-annex init"
-		handle (Just v) = do
+		handle (Just v) = unless (v `elem` supportedVersions) $
-			unless (v `elem` supportedVersions) $ do
 			error $ "Repository version " ++ v ++ 
 				" is not supported. " ++
 				msg v

configure.hs

@@ -7,7 +7,7 @@ import TestConfig
 
 tests :: [TestCase]
 tests =
-	[ TestCase "version" $ getVersion
+	[ TestCase "version" getVersion
 	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
@@ -77,8 +77,7 @@ setup = do
 	writeFile testFile "test file contents"
 
 cleanup :: IO ()
-cleanup = do
+cleanup = removeDirectoryRecursive tmpDir
-	removeDirectoryRecursive tmpDir
 
 main :: IO ()
 main = do

git-annex-shell.hs

@@ -58,10 +58,10 @@ builtins = map cmdname cmds
 builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params =
 	Git.repoAbsPath dir >>= Git.repoFromAbsPath >>=
-		dispatch (cmd:(filterparams params)) cmds commonOptions header
+		dispatch (cmd : filterparams params) cmds commonOptions header
 
 external :: [String] -> IO ()
-external params = do
+external params =
 	unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
 		error "git-shell failed"
 

git-annex.cabal

@@ -1,5 +1,5 @@
 Name: git-annex
-Version: 3.20110707
+Version: 3.20110708
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>

git-union-merge.hs

@@ -23,8 +23,7 @@ tmpIndex :: Git.Repo -> FilePath
 tmpIndex g = Git.workTree g </> Git.gitDir g </> "index.git-union-merge"
 
 setup :: Git.Repo -> IO ()
-setup g = do
+setup g = cleanup g -- idempotency
-	cleanup g -- idempotency
 
 cleanup :: Git.Repo -> IO ()
 cleanup g = do
@@ -34,7 +33,7 @@ cleanup g = do
 parseArgs :: IO [String]
 parseArgs = do
 	args <- getArgs
-	if (length args /= 3)
+	if length args /= 3
 		then usage
 		else return args
 

test.hs

@@ -19,7 +19,7 @@ import System.IO.Error
 import System.Posix.Env
 import qualified Control.Exception.Extensible as E
 import Control.Exception (throw)
-import Maybe
+import Data.Maybe
 import qualified Data.Map as M
 import System.Path (recurseDir)
 import System.IO.HVFS (SystemFS(..))
@@ -48,7 +48,7 @@ instance Arbitrary Types.Key.Key where
 	arbitrary = do
 		n <- arbitrary
 		b <- elements ['A'..'Z']
-		return $ Types.Key.Key {
+		return Types.Key.Key {
 			Types.Key.keyName = n,
 			Types.Key.keyBackendName = [b],
 			Types.Key.keySize = Nothing,
@@ -278,7 +278,7 @@ test_lock = "git-annex unlock/lock" ~: intmpclonerepo $ do
 	-- write different content, to verify that lock
 	-- throws it away
 	changecontent annexedfile
-	writeFile annexedfile $ (content annexedfile) ++ "foo"
+	writeFile annexedfile $ content annexedfile ++ "foo"
 	git_annex "lock" ["-q", annexedfile] @? "lock failed"
 	annexed_present annexedfile
 	git_annex "unlock" ["-q", annexedfile] @? "unlock failed"		
@@ -287,7 +287,7 @@ test_lock = "git-annex unlock/lock" ~: intmpclonerepo $ do
 	git_annex "add" ["-q", annexedfile] @? "add of modified file failed"
 	runchecks [checklink, checkunwritable] annexedfile
 	c <- readFile annexedfile
-	assertEqual ("content of modified file") c (changedcontent annexedfile)
+	assertEqual "content of modified file" c (changedcontent annexedfile)
 	r' <- git_annex "drop" ["-q", annexedfile]
 	not r' @? "drop wrongly succeeded with no known copy of modified file"
 
@@ -312,9 +312,9 @@ test_edit = "git-annex edit/commit" ~: TestList [t False, t True]
 					@? "git commit of edited file failed"
 		runchecks [checklink, checkunwritable] annexedfile
 		c <- readFile annexedfile
-		assertEqual ("content of modified file") c (changedcontent annexedfile)
+		assertEqual "content of modified file" c (changedcontent annexedfile)
 		r <- git_annex "drop" ["-q", annexedfile]
-		(not r) @? "drop wrongly succeeded with no known copy of modified file"
+		not r @? "drop wrongly succeeded with no known copy of modified file"
 
 test_fix :: Test
 test_fix = "git-annex fix" ~: intmpclonerepo $ do
@@ -331,7 +331,7 @@ test_fix = "git-annex fix" ~: intmpclonerepo $ do
 	git_annex "fix" ["-q", newfile] @? "fix of moved file failed"
 	runchecks [checklink, checkunwritable] newfile
 	c <- readFile newfile
-	assertEqual ("content of moved file") c (content annexedfile)
+	assertEqual "content of moved file" c (content annexedfile)
 	where
 		subdir = "s"
 		newfile = subdir ++ "/" ++ annexedfile