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 runHandler handler file filestatus = void $ do
r <- tryIO <~> handler (normalize file) filestatus r <- tryIO <~> handler (normalize file) filestatus
case r of case r of
Left e -> liftIO $ print e Left e -> liftIO $ warningIO $ show e
Right Nothing -> noop Right Nothing -> noop
Right (Just change) -> do Right (Just change) -> do
-- Just in case the commit thread is not -- 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 :: FilePath -> ChunkConfig -> Storer
store d chunkconfig k b p = do store d chunkconfig k b p = do
void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir void $ tryIO $ createDirectoryIfMissing True tmpdir
case chunkconfig of case chunkconfig of
LegacyChunks chunksize -> Legacy.store chunksize finalizer k b p tmpdir destdir 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 let tmpf = tmpdir </> keyFile k
meteredWriteFile p tmpf b meteredWriteFile p tmpf b
finalizer tmpdir destdir 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 :: 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 -> 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) =<< (liftIO $ tryIO $ L.readFile f)
where where
go meterupdate b = case chunkconfig of go meterupdate b = case chunkconfig of
@ -190,7 +190,9 @@ retrieveChunks retriever u chunkconfig encryptor basek basep sink = do
ls <- chunkKeys u chunkconfig basek ls <- chunkKeys u chunkconfig basek
liftIO $ flip catchNonAsync giveup (firstavail ls) liftIO $ flip catchNonAsync giveup (firstavail ls)
where where
giveup e = print e >> return False giveup e = do
warningIO (show e)
return False
firstavail [] = return False firstavail [] = return False
firstavail ([]:ls) = firstavail ls firstavail ([]:ls) = firstavail ls

View file

@ -74,7 +74,7 @@ storeChunks key tmp dest storer recorder finalizer = either onerr return
finalizer tmp dest finalizer tmp dest
return (not $ null stored) return (not $ null stored)
onerr e = do onerr e = do
print e warningIO (show e)
return False return False
basef = tmp ++ keyFile key basef = tmp ++ keyFile key
@ -105,7 +105,7 @@ storeChunked chunksize dests storer content = either onerr return
| otherwise = storechunks sz [] dests content | otherwise = storechunks sz [] dests content
onerr e = do onerr e = do
print e warningIO (show e)
return [] return []
storechunks _ _ [] _ = return [] -- ran out of dests 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 storeHelper r k baseurl user pass b = catchBoolIO $ do
mkdirRecursiveDAV tmpurl user pass mkdirRecursiveDAV tmpurl user pass
case chunkconfig of 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 storehttp tmpurl b
finalizer tmpurl keyurl finalizer tmpurl keyurl
return True return True