in which I discover void
void :: Functor f => f a -> f () -- ah, of course that's useful :)
This commit is contained in:
parent
be36aaca5b
commit
bee420bd2d
6 changed files with 16 additions and 29 deletions
|
@ -65,9 +65,7 @@ siblingBranches = inRepo $ Git.Ref.matchingUniq name
|
||||||
|
|
||||||
{- Creates the branch, if it does not already exist. -}
|
{- Creates the branch, if it does not already exist. -}
|
||||||
create :: Annex ()
|
create :: Annex ()
|
||||||
create = do
|
create = void $ getBranch
|
||||||
_ <- getBranch
|
|
||||||
return ()
|
|
||||||
|
|
||||||
{- Returns the ref of the branch, creating it first if necessary. -}
|
{- Returns the ref of the branch, creating it first if necessary. -}
|
||||||
getBranch :: Annex Git.Ref
|
getBranch :: Annex Git.Ref
|
||||||
|
@ -325,10 +323,9 @@ setUnCommitted = do
|
||||||
liftIO $ writeFile file "1"
|
liftIO $ writeFile file "1"
|
||||||
|
|
||||||
setCommitted :: Annex ()
|
setCommitted :: Annex ()
|
||||||
setCommitted = do
|
setCommitted = void $ do
|
||||||
file <- fromRepo gitAnnexIndexDirty
|
file <- fromRepo gitAnnexIndexDirty
|
||||||
_ <- liftIO $ tryIO $ removeFile file
|
liftIO $ tryIO $ removeFile file
|
||||||
return ()
|
|
||||||
|
|
||||||
{- Stages the journal into the index. -}
|
{- Stages the journal into the index. -}
|
||||||
stageJournal :: Annex ()
|
stageJournal :: Annex ()
|
||||||
|
|
11
Annex/Ssh.hs
11
Annex/Ssh.hs
|
@ -87,20 +87,17 @@ sshCleanup = do
|
||||||
stopssh socketfile = do
|
stopssh socketfile = do
|
||||||
let (host, port) = socket2hostport socketfile
|
let (host, port) = socket2hostport socketfile
|
||||||
(_, params) <- sshInfo (host, port)
|
(_, params) <- sshInfo (host, port)
|
||||||
_ <- liftIO $ do
|
void $ liftIO $ do
|
||||||
-- "ssh -O stop" is noisy on stderr even with -q
|
-- "ssh -O stop" is noisy on stderr even with -q
|
||||||
let cmd = unwords $ toCommand $
|
let cmd = unwords $ toCommand $
|
||||||
[ Params "-O stop"
|
[ Params "-O stop"
|
||||||
] ++ params ++ [Param host]
|
] ++ params ++ [Param host]
|
||||||
_ <- boolSystem "sh"
|
boolSystem "sh"
|
||||||
[ Param "-c"
|
[ Param "-c"
|
||||||
, Param $ "ssh " ++ cmd ++ " >/dev/null 2>/dev/null"
|
, Param $ "ssh " ++ cmd ++ " >/dev/null 2>/dev/null"
|
||||||
]
|
]
|
||||||
--try $ removeFile socketfile
|
-- Cannot remove the lock file; other processes may
|
||||||
return ()
|
-- be waiting on our exclusive lock to use it.
|
||||||
-- Cannot remove the lock file; other processes may
|
|
||||||
-- be waiting on our exclusive lock to use it.
|
|
||||||
return ()
|
|
||||||
|
|
||||||
hostport2socket :: String -> Maybe Integer -> FilePath
|
hostport2socket :: String -> Maybe Integer -> FilePath
|
||||||
hostport2socket host Nothing = host
|
hostport2socket host Nothing = host
|
||||||
|
|
|
@ -313,7 +313,7 @@ commitOnCleanup r a = go `after` a
|
||||||
cleanup
|
cleanup
|
||||||
| not $ Git.repoIsUrl r = liftIO $ onLocal r $
|
| not $ Git.repoIsUrl r = liftIO $ onLocal r $
|
||||||
Annex.Branch.commit "update"
|
Annex.Branch.commit "update"
|
||||||
| otherwise = do
|
| otherwise = void $ do
|
||||||
Just (shellcmd, shellparams) <-
|
Just (shellcmd, shellparams) <-
|
||||||
git_annex_shell r "commit" []
|
git_annex_shell r "commit" []
|
||||||
-- Throw away stderr, since the remote may not
|
-- Throw away stderr, since the remote may not
|
||||||
|
@ -322,6 +322,4 @@ commitOnCleanup r a = go `after` a
|
||||||
let cmd = shellcmd ++ " "
|
let cmd = shellcmd ++ " "
|
||||||
++ unwords (map shellEscape $ toCommand shellparams)
|
++ unwords (map shellEscape $ toCommand shellparams)
|
||||||
++ ">/dev/null 2>/dev/null"
|
++ ">/dev/null 2>/dev/null"
|
||||||
_ <- liftIO $
|
liftIO $ boolSystem "sh" [Param "-c", Param cmd]
|
||||||
boolSystem "sh" [Param "-c", Param cmd]
|
|
||||||
return ()
|
|
||||||
|
|
|
@ -47,9 +47,8 @@ runHooks r starthook stophook a = do
|
||||||
where
|
where
|
||||||
remoteid = show (uuid r)
|
remoteid = show (uuid r)
|
||||||
run Nothing = return ()
|
run Nothing = return ()
|
||||||
run (Just command) = liftIO $ do
|
run (Just command) = void $ liftIO $
|
||||||
_ <- boolSystem "sh" [Param "-c", Param command]
|
boolSystem "sh" [Param "-c", Param command]
|
||||||
return ()
|
|
||||||
firstrun lck = do
|
firstrun lck = do
|
||||||
-- Take a shared lock; This indicates that git-annex
|
-- Take a shared lock; This indicates that git-annex
|
||||||
-- is using the remote, and prevents other instances
|
-- is using the remote, and prevents other instances
|
||||||
|
|
|
@ -15,9 +15,7 @@ import Foreign (complement)
|
||||||
|
|
||||||
{- Applies a conversion function to a file's mode. -}
|
{- Applies a conversion function to a file's mode. -}
|
||||||
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
|
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
|
||||||
modifyFileMode f convert = do
|
modifyFileMode f convert = void $ modifyFileMode' f convert
|
||||||
_ <- modifyFileMode' f convert
|
|
||||||
return ()
|
|
||||||
modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
|
modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
|
||||||
modifyFileMode' f convert = do
|
modifyFileMode' f convert = do
|
||||||
s <- getFileStatus f
|
s <- getFileStatus f
|
||||||
|
|
|
@ -53,10 +53,9 @@ watchDir i test add del dir = watchDir' False i test add del dir
|
||||||
watchDir' :: Bool -> INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO ()
|
watchDir' :: Bool -> INotify -> (FilePath -> Bool) -> Maybe (FilePath -> IO ()) -> Maybe (FilePath -> IO ()) -> FilePath -> IO ()
|
||||||
watchDir' scan i test add del dir = do
|
watchDir' scan i test add del dir = do
|
||||||
if test dir
|
if test dir
|
||||||
then do
|
then void $ do
|
||||||
_ <- addWatch i watchevents dir go
|
_ <- addWatch i watchevents dir go
|
||||||
_ <- mapM walk =<< dirContents dir
|
mapM walk =<< dirContents dir
|
||||||
return ()
|
|
||||||
else return ()
|
else return ()
|
||||||
where
|
where
|
||||||
watchevents
|
watchevents
|
||||||
|
@ -92,6 +91,5 @@ waitForTermination = do
|
||||||
check keyboardSignal mv
|
check keyboardSignal mv
|
||||||
takeMVar mv
|
takeMVar mv
|
||||||
where
|
where
|
||||||
check sig mv = do
|
check sig mv = void $
|
||||||
_ <- installHandler sig (CatchOnce $ putMVar mv ()) Nothing
|
installHandler sig (CatchOnce $ putMVar mv ()) Nothing
|
||||||
return ()
|
|
||||||
|
|
Loading…
Reference in a new issue