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
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue