another memory optimisation

This time memory leaked if lots of UUIDs needed to be pretty-printed, as in
a get or drop of many files. Essentially the same strict read buffering
problem that affected the LocationLog underneath though.

uuidMap really could stand to be cached, as the uuid log is read many times
in this case. But it is a fairly edge case.
This commit is contained in:
Joey Hess 2010-10-31 01:51:50 -04:00
parent 59672d32ed
commit 6a9a9bd5a3
2 changed files with 6 additions and 20 deletions

10
UUID.hs
View file

@ -26,6 +26,7 @@ import System.Cmd.Utils
import System.IO
import System.Directory
import qualified Data.Map as M
import System.Posix.Process
import qualified GitRepo as Git
import Types
@ -111,8 +112,11 @@ describeUUID uuid desc = do
m <- uuidMap
let m' = M.insert uuid desc m
log <- uuidLog
pid <- liftIO $ getProcessID
let tmplog = log ++ ".tmp" ++ show pid
liftIO $ createDirectoryIfMissing True (parentDir log)
liftIO $ withFileLocked log WriteMode (\h -> hPutStr h $ serialize m')
liftIO $ writeFile tmplog $ serialize m'
liftIO $ renameFile tmplog log
where
serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
@ -120,9 +124,7 @@ describeUUID uuid desc = do
uuidMap :: Annex (M.Map UUID String)
uuidMap = do
log <- uuidLog
s <- liftIO $ catch
(withFileLocked log ReadMode $ \h -> hGetContentsStrict h)
(\error -> return "")
s <- liftIO $ catch (readFile log) (\error -> return "")
return $ M.fromList $ map (\l -> pair l) $ lines s
where
pair l =

View file

@ -6,7 +6,6 @@
-}
module Utility (
withFileLocked,
hGetContentsStrict,
parentDir,
relPathCwdToDir,
@ -28,21 +27,6 @@ import System.IO.HVFS
import System.FilePath
import System.Directory
{- Let's just say that Haskell makes reading/writing a file with
- file locking excessively difficult. -}
withFileLocked file mode action = do
-- TODO: find a way to use bracket here
handle <- openFile file mode
lockfd <- handleToFd handle -- closes handle
waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0)
handle' <- fdToHandle lockfd
ret <- action handle'
hClose handle'
return ret
where
lockType ReadMode = ReadLock
lockType _ = WriteLock
{- A version of hgetContents that is not lazy. Ensures file is
- all read before it gets closed. -}
hGetContentsStrict h = hGetContents h >>= \s -> length s `seq` return s