better exception display
This commit is contained in:
parent
0d89b65bfc
commit
867fd116a7
5 changed files with 10 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue