noop

Annex/Content.hs

@@ -98,7 +98,7 @@ lockContent key a = do
 			case v of
 				Left _ -> error "content is locked"
 				Right _ -> return $ Just fd
-		unlock Nothing = return ()
+		unlock Nothing = noop
 		unlock (Just l) = closeFd l
 
 {- Calculates the relative path to use to link a file to a key. -}
@@ -237,10 +237,10 @@ cleanObjectLoc key = do
 	file <- inRepo $ gitAnnexLocation key
 	liftIO $ removeparents file (3 :: Int)
 	where
-		removeparents _ 0 = return ()
+		removeparents _ 0 = noop
 		removeparents file n = do
 			let dir = parentDir file
-			maybe (return ()) (const $ removeparents dir (n-1))
+			maybe noop (const $ removeparents dir (n-1))
 				=<< catchMaybeIO (removeDirectory dir)
 
 {- Removes a key's file from .git/annex/objects/ -}

Annex/LockPool.hs

@@ -18,7 +18,7 @@ import Annex.Perms
 lockFile :: FilePath -> Annex ()
 lockFile file = go =<< fromPool file
 	where
-		go (Just _) = return () -- already locked
+		go (Just _) = noop -- already locked
 		go Nothing = do
 			mode <- annexFileMode
 			fd <- liftIO $ noUmask mode $
@@ -27,10 +27,9 @@ lockFile file = go =<< fromPool file
 			changePool $ M.insert file fd
 
 unlockFile :: FilePath -> Annex ()
-unlockFile file = go =<< fromPool file
+unlockFile file = maybe noop go =<< fromPool file
 	where
-		go Nothing = return ()
-		go (Just fd) = do
+		go fd = do
 			liftIO $ closeFd fd
 			changePool $ M.delete file
 

Annex/Perms.hs

@@ -37,7 +37,7 @@ setAnnexPerm file = withShared $ liftIO . go
 		go GroupShared = groupWriteRead file
 		go AllShared = modifyFileMode file $ addModes $
 			[ ownerWriteMode, groupWriteMode ] ++ readModes
-		go _ = return ()
+		go _ = noop
 
 {- Gets the appropriate mode to use for creating a file in the annex
  - (other than content files, which are locked down more). -}

Annex/Ssh.hs

@@ -81,7 +81,7 @@ sshCleanup = do
 			v <- liftIO $ tryIO $
 				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
-				Left _ -> return ()
+				Left _ -> noop
 				Right _ -> stopssh socketfile
 			liftIO $ closeFd fd
 		stopssh socketfile = do

Annex/Version.hs

@@ -35,7 +35,7 @@ setVersion = setConfig versionField defaultVersion
 
 checkVersion :: Version -> Annex ()
 checkVersion v
-	| v `elem` supportedVersions = return ()
+	| v `elem` supportedVersions = noop
 	| v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade"
 	| otherwise = err "Upgrade git-annex."
 	where

CmdLine.hs

@@ -88,7 +88,7 @@ tryRun = tryRun' 0
 tryRun' :: Integer -> Annex.AnnexState -> Command -> [CommandCleanup] -> IO ()
 tryRun' errnum _ cmd []
 	| errnum > 0 = error $ cmdname cmd ++ ": " ++ show errnum ++ " failed"
-	| otherwise = return ()
+	| otherwise = noop
 tryRun' errnum state cmd (a:as) = do
 	r <- run
 	handle $! r

Command/Fsck.hs

@@ -85,7 +85,7 @@ performRemote key file backend numcopies remote =
 			t <- fromRepo gitAnnexTmpDir
 			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
 			liftIO $ createDirectoryIfMissing True t
-			let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
+			let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
 			cleanup
 			cleanup `after` a tmp
 		getfile tmp =

Command/Status.hs

@@ -108,12 +108,11 @@ nojson :: StatState String -> String -> StatState String
 nojson a _ = a
 
 showStat :: Stat -> StatState ()
-showStat s = calc =<< s
+showStat s = maybe noop calc =<< s
 	where
-		calc (Just (desc, a)) = do
+		calc (desc, a) = do
 			(lift . showHeader) desc
 			lift . showRaw =<< a
-		calc Nothing = return ()
 
 supported_backends :: Stat
 supported_backends = stat "supported backends" $ json unwords $

Command/Unused.hs

@@ -268,7 +268,7 @@ withKeysReferencedInGitRef a ref = do
 	showAction $ "checking " ++ Git.Ref.describe ref
 	go =<< inRepo (LsTree.lsTree ref)
 	where
-		go [] = return ()
+		go [] = noop
 		go (l:ls)
 			| isSymLink (LsTree.mode l) = do
 				content <- L.decodeUtf8 <$> catFile ref (LsTree.file l)

Command/Whereis.hs

@@ -46,9 +46,9 @@ perform remotemap key = do
 		untrustedheader = "The following untrusted locations may also have copies:\n"
 
 performRemote :: Key -> Remote -> Annex () 
-performRemote key remote = case whereisKey remote of
-	Nothing -> return ()
-	Just a -> do
+performRemote key remote = maybe noop go $ whereisKey remote
+	where
+		go a = do
 			ls <- a key
-		unless (null ls) $ showLongNote $
-			unlines $ map (\l -> name remote ++ ": " ++ l) ls
+			unless (null ls) $ showLongNote $ unlines $
+				map (\l -> name remote ++ ": " ++ l) ls

Git/Command.hs

@@ -79,5 +79,5 @@ pipeNullSplit params repo =
 reap :: IO ()
 reap = do
 	-- throws an exception when there are no child processes
-	r <- catchDefaultIO (getAnyProcessStatus False True) Nothing
-	maybe (return ()) (const reap) r
+	catchDefaultIO (getAnyProcessStatus False True) Nothing
+		>>= maybe noop (const reap)

Git/Construct.hs

@@ -48,7 +48,7 @@ import qualified Git.Url as Url
 fromCurrent :: IO Repo
 fromCurrent = do
 	r <- maybe fromCwd fromPath =<< getEnv "GIT_DIR"
-	maybe (return ()) changeWorkingDirectory =<< getEnv "GIT_WORK_TREE"
+	maybe noop changeWorkingDirectory =<< getEnv "GIT_WORK_TREE"
 	unsetEnv "GIT_DIR"
 	unsetEnv "GIT_WORK_TREE"
 	return r

Git/UnionMerge.hs

@@ -97,7 +97,7 @@ calc_merge :: CatFileHandle -> [String] -> Repo -> Streamer
 calc_merge ch differ repo streamer = gendiff >>= go
 	where
 		gendiff = pipeNullSplit (map Param differ) repo
-		go [] = return ()
+		go [] = noop
 		go (info:file:rest) = mergeFile info file ch repo >>=
 			maybe (go rest) (\l -> streamer l >> go rest)
 		go (_:[]) = error "calc_merge parse error"

GitAnnexShell.hs

@@ -52,7 +52,7 @@ options = Option.common ++
 	where
 		checkuuid expected = getUUID >>= check
 			where
-				check u | u == toUUID expected = return ()
+				check u | u == toUUID expected = noop
 				check NoUUID = unexpected "uninitialized repository"
 				check u = unexpected $ "UUID " ++ fromUUID u
 				unexpected s = error $
@@ -107,7 +107,7 @@ checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
 
 checkNotReadOnly :: String -> IO ()
 checkNotReadOnly cmd
-	| cmd `elem` map cmdname cmds_readonly = return ()
+	| cmd `elem` map cmdname cmds_readonly = noop
 	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
 
 checkEnv :: String -> IO ()

Logs/Location.hs

@@ -30,7 +30,7 @@ import Logs.Presence
 {- Log a change in the presence of a key's value in a repository. -}
 logChange :: Key -> UUID -> LogStatus -> Annex ()
 logChange key (UUID u) s = addLog (logFile key) =<< logNow s u
-logChange _ NoUUID _ = return ()
+logChange _ NoUUID _ = noop
 
 {- Returns a list of repository UUIDs that, according to the log, have
  - the value of a key.

Logs/UUID.hs

@@ -73,7 +73,7 @@ recordUUID u = go . M.lookup u =<< uuidMap
 	where
 		go (Just "") = set
 		go Nothing = set
-		go _ = return ()
+		go _ = noop
 		set = describeUUID u ""
 
 {- Read the uuidLog into a simple Map.

Messages.hs

@@ -73,7 +73,7 @@ metered key a = Annex.getState Annex.output >>= go (keySize key)
 				displayMeter stdout meter
 			liftIO $ clearMeter stdout meter
 			return r
-                go _ _ = a (const $ return ())
+                go _ _ = a (const noop)
 
 showSideAction :: String -> Annex ()
 showSideAction s = handle q $
@@ -160,7 +160,7 @@ handle json normal = Annex.getState Annex.output >>= go
 		go Annex.JSONOutput = liftIO $ flushed json
 
 q :: Monad m => m ()
-q = return ()
+q = noop
 
 flushed :: IO () -> IO ()
 flushed a = a >> hFlush stdout

Remote.hs

@@ -194,7 +194,7 @@ showLocations key exclude = do
 		message rs us = message rs [] ++ message [] us
 
 showTriedRemotes :: [Remote] -> Annex ()
-showTriedRemotes [] = return ()	
+showTriedRemotes [] = noop
 showTriedRemotes remotes =
 	showLongNote $ "Unable to access these remotes: " ++
 		join ", " (map name remotes)

Remote/Directory.hs

@@ -195,7 +195,8 @@ meteredWriteFile' meterupdate dest startstate feeder =
 	where
 		feed state [] h = do
 			(state', cs) <- feeder state
-			if null cs then return () else feed state' cs h
+			unless (null cs) $
+				feed state' cs h
 		feed state (c:cs) h = do
 			S.hPut h c
 			meterupdate $ toInteger $ S.length c

Remote/Helper/Hooks.hs

@@ -46,7 +46,7 @@ runHooks r starthook stophook a = do
 	a
 	where
 		remoteid = show (uuid r)
-		run Nothing = return ()
+		run Nothing = noop
 		run (Just command) = void $ liftIO $
 			boolSystem "sh" [Param "-c", Param command]
 		firstrun lck = do
@@ -81,7 +81,7 @@ runHooks r starthook stophook a = do
 			v <- liftIO $ tryIO $
 				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
-				Left _ -> return ()
+				Left _ -> noop
 				Right _ -> run stophook
 			liftIO $ closeFd fd
 

Remote/S3.hs

@@ -93,7 +93,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
 
 		archiveorg = do
 			showNote "Internet Archive mode"
-			maybe (error "specify bucket=") (const $ return ()) $
+			maybe (error "specify bucket=") (const noop) $
 				M.lookup "bucket" archiveconfig
 			use archiveconfig
 			where
@@ -237,13 +237,13 @@ genBucket c = do
 	showAction "checking bucket"
 	loc <- liftIO $ getBucketLocation conn bucket 
 	case loc of
-		Right _ -> return ()
+		Right _ -> noop
 		Left err@(NetworkError _) -> s3Error err
 		Left (AWSError _ _) -> do
 			showAction $ "creating bucket in " ++ datacenter
 			res <- liftIO $ createBucketIn conn bucket datacenter
 			case res of
-				Right _ -> return ()
+				Right _ -> noop
 				Left err -> s3Error err
 	where
 		bucket = fromJust $ M.lookup "bucket" c

Upgrade/V1.hs

@@ -89,7 +89,7 @@ updateSymlinks = do
 		fixlink f = do
 			r <- lookupFile1 f
 			case r of
-				Nothing -> return ()
+				Nothing -> noop
 				Just (k, _) -> do
 					link <- calcGitLink f k
 					liftIO $ removeFile f

Utility/Directory.hs

@@ -19,6 +19,7 @@ import Control.Applicative
 import Utility.SafeCommand
 import Utility.TempFile
 import Utility.Exception
+import Utility.Monad
 
 {- Lists the contents of a directory.
  - Unlike getDirectoryContents, paths are not relative to the directory. -}
@@ -34,7 +35,7 @@ dirContents d = map (d </>) . filter notcruft <$> getDirectoryContents d
 moveFile :: FilePath -> FilePath -> IO ()
 moveFile src dest = tryIO (rename src dest) >>= onrename
 	where
-		onrename (Right _) = return ()
+		onrename (Right _) = noop
 		onrename (Left e)
 			| isPermissionError e = rethrow
 			| isDoesNotExistError e = rethrow

Utility/Inotify.hs

@@ -56,7 +56,7 @@ watchDir' scan i test add del dir = do
 		then void $ do
 			_ <- addWatch i watchevents dir go
 			mapM walk =<< dirContents dir
-		else return ()
+		else noop
 	where
 		watchevents
 			| isJust add && isJust del =
@@ -68,19 +68,19 @@ watchDir' scan i test add del dir = do
 		recurse = watchDir' scan i test add del
 		walk f = ifM (catchBoolIO $ Files.isDirectory <$> getFileStatus f)
 			( recurse f
-			, if scan && isJust add then fromJust add f else return ()
+			, when (scan && isJust add) $ fromJust add f
 			)
 
-		go (Created { isDirectory = False }) = return ()
+		go (Created { isDirectory = False }) = noop
 		go (Created { filePath = subdir }) = Just recurse <@> subdir
 		go (Closed { maybeFilePath = Just f }) = add <@> f
 		go (MovedIn { isDirectory = False, filePath = f }) = add <@> f
 		go (MovedOut { isDirectory = False, filePath = f }) = del <@> f
 		go (Deleted { isDirectory = False, filePath = f }) = del <@> f
-		go _ = return ()
+		go _ = noop
 		
 		Just a <@> f = a $ dir </> f
-		Nothing <@> _ = return ()
+		Nothing <@> _ = noop
 
 {- Pauses the main thread, letting children run until program termination. -}
 waitForTermination :: IO ()

Utility/Monad.hs

@@ -49,3 +49,7 @@ observe observer a = do
 {- b `after` a runs first a, then b, and returns the value of a -}
 after :: Monad m => m b -> m a -> m a
 after = observe . const
+
+{- do nothing -}
+noop :: Monad m => m ()
+noop = return ()

Utility/Touch.hsc

@@ -106,9 +106,8 @@ touchBoth file atime mtime follow =
 	withFilePath file $ \f -> do
 		pokeArray ptr [atime, mtime]
 		r <- syscall f ptr
-		if (r /= 0)
-			then throwErrno "touchBoth"
-			else return ()
+		when (r /= 0) $
+			throwErrno "touchBoth"
 	where
 		syscall = if follow
 			then c_lutimes
@@ -116,6 +115,6 @@ touchBoth file atime mtime follow =
 
 #else
 #warning "utimensat and lutimes not available; building without symlink timestamp preservation support"
-touchBoth _ _ _ _ = return ()
+touchBoth _ _ _ _ = noop
 #endif
 #endif

Utility/Url.hs

@@ -17,6 +17,7 @@ import Common
 import qualified Network.Browser as Browser
 import Network.HTTP
 import Network.URI
+import Utility.Monad
 
 type URLString = String
 
@@ -95,7 +96,7 @@ request url requesttype = go 5 url
 			case rspCode rsp of
 				(3,0,x) | x /= 5 -> redir (n - 1) u rsp
 				_ -> return rsp
-		ignore = const $ return ()
+		ignore = const noop
 		redir n u rsp = case retrieveHeaders HdrLocation rsp of
 			[] -> return rsp
 			(Header _ newu:_) ->