diff --git a/Annex/Content.hs b/Annex/Content.hs index 7022364d09..c5771af28e 100644 --- a/Annex/Content.hs +++ b/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/ -} diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs index 3eb1363eed..b99a8ec4df 100644 --- a/Annex/LockPool.hs +++ b/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 diff --git a/Annex/Perms.hs b/Annex/Perms.hs index 12dfdd6679..c54908b439 100644 --- a/Annex/Perms.hs +++ b/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). -} diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 02a1ee705a..6a230312ab 100644 --- a/Annex/Ssh.hs +++ b/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 diff --git a/Annex/Version.hs b/Annex/Version.hs index cf5d224842..a1d0402445 100644 --- a/Annex/Version.hs +++ b/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 diff --git a/CmdLine.hs b/CmdLine.hs index ebaef5369d..910f228b60 100644 --- a/CmdLine.hs +++ b/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 diff --git a/Command/Fsck.hs b/Command/Fsck.hs index c60101fc79..38b1bbbacd 100644 --- a/Command/Fsck.hs +++ b/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 = diff --git a/Command/Status.hs b/Command/Status.hs index 1ee36d8b47..0c6eda0b2a 100644 --- a/Command/Status.hs +++ b/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 $ diff --git a/Command/Unused.hs b/Command/Unused.hs index bc721635b7..5bdadcf44a 100644 --- a/Command/Unused.hs +++ b/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) diff --git a/Command/Whereis.hs b/Command/Whereis.hs index d4d268d937..eb6ea7c56d 100644 --- a/Command/Whereis.hs +++ b/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 - ls <- a key - unless (null ls) $ showLongNote $ - unlines $ map (\l -> name remote ++ ": " ++ l) ls +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 diff --git a/Git/Command.hs b/Git/Command.hs index 50d4455fe7..bb82d13395 100644 --- a/Git/Command.hs +++ b/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) diff --git a/Git/Construct.hs b/Git/Construct.hs index 49905f818b..3f3ea97476 100644 --- a/Git/Construct.hs +++ b/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 diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index 90bbf5c4cc..d68bb61ab1 100644 --- a/Git/UnionMerge.hs +++ b/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" diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 0cf81f0e21..6633037138 100644 --- a/GitAnnexShell.hs +++ b/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 () diff --git a/Logs/Location.hs b/Logs/Location.hs index b6d59b928c..e27ece5d46 100644 --- a/Logs/Location.hs +++ b/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. diff --git a/Logs/UUID.hs b/Logs/UUID.hs index 18cbee61e4..d825e11273 100644 --- a/Logs/UUID.hs +++ b/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. diff --git a/Messages.hs b/Messages.hs index 73a7d976fd..af7eb88b43 100644 --- a/Messages.hs +++ b/Messages.hs @@ -72,8 +72,8 @@ metered key a = Annex.getState Annex.output >>= go (keySize key) incrP progress n displayMeter stdout meter liftIO $ clearMeter stdout meter - return r - go _ _ = a (const $ return ()) + return r + 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 diff --git a/Remote.hs b/Remote.hs index aac45fae9d..e9e66990c5 100644 --- a/Remote.hs +++ b/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) diff --git a/Remote/Directory.hs b/Remote/Directory.hs index fd5a6f0b19..7521e70135 100644 --- a/Remote/Directory.hs +++ b/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 diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 40484b2a7c..d85959062e 100644 --- a/Remote/Helper/Hooks.hs +++ b/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 diff --git a/Remote/S3.hs b/Remote/S3.hs index a688ffcf34..18d4915dcb 100644 --- a/Remote/S3.hs +++ b/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 diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 62e3b3b313..a8005b2644 100644 --- a/Upgrade/V1.hs +++ b/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 diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 40e65d6349..e6622d31ee 100644 --- a/Utility/Directory.hs +++ b/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 diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs index 0a261ecfe0..d41e997d61 100644 --- a/Utility/Inotify.hs +++ b/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 () diff --git a/Utility/Monad.hs b/Utility/Monad.hs index 9c85d31ca8..2c9b9e9e07 100644 --- a/Utility/Monad.hs +++ b/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 () diff --git a/Utility/Touch.hsc b/Utility/Touch.hsc index b53eab634e..e2dba79ab2 100644 --- a/Utility/Touch.hsc +++ b/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 diff --git a/Utility/Url.hs b/Utility/Url.hs index 86d66d83b5..20c5db574d 100644 --- a/Utility/Url.hs +++ b/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:_) ->