mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

convert safeSystem to boolSystem

Browse source 
to fix ctrl-c handling
This commit is contained in:
Joey Hess 2010-10-29 14:07:26 -04:00
parent fa04c36fbe
commit d92f186fc4
2 changed files with 6 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Backend/URL.hs
View file

@ -7,7 +7,6 @@
module Backend.URL (backend) where module Backend.URL (backend) where
import Control.Exception
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Data.String.Utils import Data.String.Utils
import System.Cmd import System.Cmd
@ -16,6 +15,7 @@ import System.Exit
import TypeInternals import TypeInternals
import Core import Core
import Utility
backend = Backend { backend = Backend {
name = "URL", name = "URL",
@ -42,10 +42,6 @@ downloadUrl :: Key -> FilePath -> Annex Bool
downloadUrl key file = do downloadUrl key file = do
showNote "downloading" showNote "downloading"
liftIO $ putStrLn "" -- make way for curl progress bar liftIO $ putStrLn "" -- make way for curl progress bar
result <- liftIO $ (try curl::IO (Either SomeException ())) liftIO $ boolSystem "curl" ["-#", "-o", file, url]
case result of
Left err -> return False
Right succ -> return True
where where
curl = safeSystem "curl" ["-#", "-o", file, url]
url = join ":" $ drop 1 $ split ":" $ show key url = join ":" $ drop 1 $ split ":" $ show key

6
GitRepo.hs
View file

@ -35,6 +35,7 @@ module GitRepo (
notInRepo notInRepo
) where ) where
import Monad (when, unless)
import Directory import Directory
import System import System
import System.Directory import System.Directory
@ -183,10 +184,11 @@ gitCommandLine repo@(Repo { location = Dir d} ) params =
["--git-dir="++d++"/"++(dir repo), "--work-tree="++d] ++ params ["--git-dir="++d++"/"++(dir repo), "--work-tree="++d] ++ params
gitCommandLine repo _ = assertLocal repo $ error "internal" gitCommandLine repo _ = assertLocal repo $ error "internal"
{- Runs git in the specified repo. -} {- Runs git in the specified repo, throwing an error if it fails. -}
run :: Repo -> [String] -> IO () run :: Repo -> [String] -> IO ()
run repo params = assertLocal repo $ do run repo params = assertLocal repo $ do
safeSystem "git" (gitCommandLine repo params) ok <- boolSystem "git" (gitCommandLine repo params)
unless (ok) $ error $ "git " ++ (show params) ++ " failed"
{- Runs a git subcommand and returns its output. -} {- Runs a git subcommand and returns its output. -}
pipeRead :: Repo -> [String] -> IO String pipeRead :: Repo -> [String] -> IO String