better exception display

This commit is contained in:
Joey Hess 2014-07-26 23:01:44 -04:00
parent 0d89b65bfc
commit 867fd116a7
5 changed files with 10 additions and 8 deletions

View file

@ -184,7 +184,7 @@ runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()
runHandler handler file filestatus = void $ do
r <- tryIO <~> handler (normalize file) filestatus
case r of
Left e -> liftIO $ print e
Left e -> liftIO $ warningIO $ show e
Right Nothing -> noop
Right (Just change) -> do
-- Just in case the commit thread is not

View file

@ -114,10 +114,10 @@ prepareStore d chunkconfig k = ifM (checkDiskSpace (Just d) k 0)
store :: FilePath -> ChunkConfig -> Storer
store d chunkconfig k b p = do
void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir
void $ tryIO $ createDirectoryIfMissing True tmpdir
case chunkconfig of
LegacyChunks chunksize -> Legacy.store chunksize finalizer k b p tmpdir destdir
_ -> flip catchNonAsync (\e -> print e >> return False) $ do
_ -> flip catchNonAsync (\e -> warningIO (show e) >> return False) $ do
let tmpf = tmpdir </> keyFile k
meteredWriteFile p tmpf b
finalizer tmpdir destdir

View file

@ -77,7 +77,7 @@ numChunks = pred . fromJust . keyChunkNum . fst . nextChunkKeyStream
-}
storeChunks :: UUID -> ChunkConfig -> Key -> FilePath -> MeterUpdate -> (Key -> L.ByteString -> MeterUpdate -> IO Bool) -> Annex Bool
storeChunks u chunkconfig k f p storer = metered (Just p) k $ \meterupdate ->
either (\e -> liftIO (print e) >> return False) (go meterupdate)
either (\e -> warning (show e) >> return False) (go meterupdate)
=<< (liftIO $ tryIO $ L.readFile f)
where
go meterupdate b = case chunkconfig of
@ -190,7 +190,9 @@ retrieveChunks retriever u chunkconfig encryptor basek basep sink = do
ls <- chunkKeys u chunkconfig basek
liftIO $ flip catchNonAsync giveup (firstavail ls)
where
giveup e = print e >> return False
giveup e = do
warningIO (show e)
return False
firstavail [] = return False
firstavail ([]:ls) = firstavail ls

View file

@ -74,7 +74,7 @@ storeChunks key tmp dest storer recorder finalizer = either onerr return
finalizer tmp dest
return (not $ null stored)
onerr e = do
print e
warningIO (show e)
return False
basef = tmp ++ keyFile key
@ -105,7 +105,7 @@ storeChunked chunksize dests storer content = either onerr return
| otherwise = storechunks sz [] dests content
onerr e = do
print e
warningIO (show e)
return []
storechunks _ _ [] _ = return [] -- ran out of dests

View file

@ -113,7 +113,7 @@ storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString ->
storeHelper r k baseurl user pass b = catchBoolIO $ do
mkdirRecursiveDAV tmpurl user pass
case chunkconfig of
NoChunks -> flip catchNonAsync (\e -> print e >> return False) $ do
NoChunks -> flip catchNonAsync (\e -> warningIO (show e) >> return False) $ do
storehttp tmpurl b
finalizer tmpurl keyurl
return True