fixed close after locking
This commit is contained in:
parent
11ad93f023
commit
f98fa53d7f
3 changed files with 16 additions and 8 deletions
|
@ -12,6 +12,11 @@
|
|||
-
|
||||
- A line of the log will look like: "date N reponame"
|
||||
- Where N=1 when the repo has the file, and 0 otherwise.
|
||||
-
|
||||
- TOOD: compact logs, by storing only current presence infomation when
|
||||
- writing them.
|
||||
-
|
||||
- TODO: use ByteString
|
||||
-}
|
||||
|
||||
module LocationLog where
|
||||
|
@ -67,9 +72,8 @@ readLog file = do
|
|||
exists <- doesFileExist file
|
||||
if exists
|
||||
then do
|
||||
h <- openLocked file ReadMode
|
||||
s <- hGetContentsStrict h
|
||||
hClose h
|
||||
s <- withFileLocked file ReadMode $ \h ->
|
||||
hGetContentsStrict h
|
||||
-- filter out any unparsable lines
|
||||
return $ filter (\l -> (status l) /= Undefined )
|
||||
$ map read $ lines s
|
||||
|
@ -80,9 +84,8 @@ readLog file = do
|
|||
writeLog :: String -> LogLine -> IO ()
|
||||
writeLog file line = do
|
||||
createDirectoryIfMissing True (parentDir file)
|
||||
h <- openLocked file AppendMode
|
||||
withFileLocked file AppendMode $ \h ->
|
||||
hPutStrLn h $ show line
|
||||
hClose h
|
||||
|
||||
{- Generates a new LogLine with the current date. -}
|
||||
logNow :: LogStatus -> String -> IO LogLine
|
||||
|
|
|
@ -9,12 +9,15 @@ import Data.String.Utils
|
|||
|
||||
{- Let's just say that Haskell makes reading/writing a file with
|
||||
- file locking excessively difficult. -}
|
||||
openLocked file mode = do
|
||||
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
|
||||
return handle'
|
||||
ret <- action handle'
|
||||
hClose handle'
|
||||
return ret
|
||||
where
|
||||
lockType ReadMode = ReadLock
|
||||
lockType _ = WriteLock
|
||||
|
|
|
@ -6,3 +6,5 @@ import GitRepo
|
|||
|
||||
main = do
|
||||
gitPrep
|
||||
l <- readLog "demo.log"
|
||||
writeLog "demo2.log" $ l !! 0
|
||||
|
|
Loading…
Reference in a new issue