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:
parent
59672d32ed
commit
6a9a9bd5a3
2 changed files with 6 additions and 20 deletions
10
UUID.hs
10
UUID.hs
|
@ -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 =
|
||||
|
|
16
Utility.hs
16
Utility.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue