summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-04-21 23:32:33 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-04-21 23:32:33 -0400
commited79596b758935a3f22bf6803bc082a6bbe10f58 (patch)
tree885a8a50e68dafb39ec886cb31aa4c549fbeb35e
parentbee420bd2d0cbe16489b061b208083e2b8ba9d0e (diff)
noop
-rw-r--r--Annex/Content.hs6
-rw-r--r--Annex/LockPool.hs7
-rw-r--r--Annex/Perms.hs2
-rw-r--r--Annex/Ssh.hs2
-rw-r--r--Annex/Version.hs2
-rw-r--r--CmdLine.hs2
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/Status.hs5
-rw-r--r--Command/Unused.hs2
-rw-r--r--Command/Whereis.hs12
-rw-r--r--Git/Command.hs4
-rw-r--r--Git/Construct.hs2
-rw-r--r--Git/UnionMerge.hs2
-rw-r--r--GitAnnexShell.hs4
-rw-r--r--Logs/Location.hs2
-rw-r--r--Logs/UUID.hs2
-rw-r--r--Messages.hs6
-rw-r--r--Remote.hs2
-rw-r--r--Remote/Directory.hs3
-rw-r--r--Remote/Helper/Hooks.hs4
-rw-r--r--Remote/S3.hs6
-rw-r--r--Upgrade/V1.hs2
-rw-r--r--Utility/Directory.hs3
-rw-r--r--Utility/Inotify.hs10
-rw-r--r--Utility/Monad.hs4
-rw-r--r--Utility/Touch.hsc7
-rw-r--r--Utility/Url.hs3
27 files changed, 56 insertions, 52 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 7022364d0..c5771af28 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 3eb1363ee..b99a8ec4d 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 12dfdd667..c54908b43 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 02a1ee705..6a230312a 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 cf5d22484..a1d040244 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 ebaef5369..910f228b6 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 c60101fc7..38b1bbbac 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 1ee36d8b4..0c6eda0b2 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 bc721635b..5bdadcf44 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 d4d268d93..eb6ea7c56 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 50d4455fe..bb82d1339 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 49905f818..3f3ea9747 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 90bbf5c4c..d68bb61ab 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 0cf81f0e2..663303713 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 b6d59b928..e27ece5d4 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 18cbee61e..d825e1127 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 73a7d976f..af7eb88b4 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 aac45fae9..e9e66990c 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 fd5a6f0b1..7521e7013 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 40484b2a7..d85959062 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 a688ffcf3..18d4915dc 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 62e3b3b31..a8005b264 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 40e65d634..e6622d31e 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 0a261ecfe..d41e997d6 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 9c85d31ca..2c9b9e9e0 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 b53eab634..e2dba79ab 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 86d66d83b..20c5db574 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:_) ->