diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-12-08 18:26:03 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-12-08 18:42:52 -0400 |
commit | c5f29d780863b010aa2893bfa3935588d22b7e13 (patch) | |
tree | cb84e106b41bd85e2e3cb42f9f86258caf6a0800 /P2P/Annex.hs | |
parent | e983b6e352b48233f9526497b4317950d0cfa92f (diff) |
fix memory leak
I'm unsure why this fixed it, but it did. Seems to suggest that the
memory leak is not due to a bug in my code, but that ghc didn't manage
to take full advantage of laziness, or was failing to gc something it
could have.
Diffstat (limited to 'P2P/Annex.hs')
-rw-r--r-- | P2P/Annex.hs | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/P2P/Annex.hs b/P2P/Annex.hs index d55d69bdb..3b95c8c02 100644 --- a/P2P/Annex.hs +++ b/P2P/Annex.hs @@ -72,15 +72,15 @@ runLocal runmode runner a = case a of Right b -> runner (next b) Right Nothing -> return (Left "content not available") Left e -> return (Left (show e)) - StoreContent k af o l b next -> do + StoreContent k af o l getb next -> do ok <- flip catchNonAsync (const $ return False) $ transfer download k af $ getViaTmp AlwaysVerify k $ \tmp -> - unVerified $ storefile tmp o l b + unVerified $ storefile tmp o l getb runner (next ok) - StoreContentTo dest o l b next -> do + StoreContentTo dest o l getb next -> do ok <- flip catchNonAsync (const $ return False) $ - storefile dest o l b + storefile dest o l getb runner (next ok) SetPresent k u next -> do v <- tryNonAsync $ logChange k u InfoPresent @@ -120,10 +120,14 @@ runLocal runmode runner a = case a of -- Transfer logs are updated higher in the stack when -- a client. Client -> ta - storefile dest (Offset o) (Len l) b = liftIO $ do - withBinaryFile dest ReadWriteMode $ \h -> do - when (o /= 0) $ - hSeek h AbsoluteSeek o - L.hPut h b - sz <- getFileSize dest - return (toInteger sz == l + o) + storefile dest (Offset o) (Len l) getb = do + v <- runner getb + case v of + Right b -> liftIO $ do + withBinaryFile dest ReadWriteMode $ \h -> do + when (o /= 0) $ + hSeek h AbsoluteSeek o + L.hPut h b + sz <- liftIO $ getFileSize dest + return (toInteger sz == l + o) + Left e -> error e |