diff options
Diffstat (limited to 'src/Erebos/Storage')
| -rw-r--r-- | src/Erebos/Storage/Internal.hs | 6 | ||||
| -rw-r--r-- | src/Erebos/Storage/Key.hs | 7 | ||||
| -rw-r--r-- | src/Erebos/Storage/Merge.hs | 7 |
3 files changed, 12 insertions, 8 deletions
diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs index d419a5e..8b794d8 100644 --- a/src/Erebos/Storage/Internal.hs +++ b/src/Erebos/Storage/Internal.hs @@ -241,7 +241,7 @@ writeFileOnce file content = bracket (openLockFile locked) doesFileExist file >>= \case True -> removeFile locked False -> do BL.hPut h content - hFlush h + hClose h renameFile locked file where locked = file ++ ".lock" @@ -254,13 +254,13 @@ writeFileChecked file prev content = bracket (openLockFile locked) removeFile locked return $ Left $ Just current (Nothing, False) -> do B.hPut h content - hFlush h + hClose h renameFile locked file return $ Right () (Just expected, True) -> do current <- B.readFile file if current == expected then do B.hPut h content - hFlush h + hClose h renameFile locked file return $ return () else do removeFile locked diff --git a/src/Erebos/Storage/Key.hs b/src/Erebos/Storage/Key.hs index b6afc20..5da79e3 100644 --- a/src/Erebos/Storage/Key.hs +++ b/src/Erebos/Storage/Key.hs @@ -80,6 +80,7 @@ moveKeys from to = liftIO $ do return M.empty (StorageMemory { memKeys = fromKeys }, StorageMemory { memKeys = toKeys }) -> do - modifyMVar_ fromKeys $ \fkeys -> do - modifyMVar_ toKeys $ return . M.union fkeys - return M.empty + when (fromKeys /= toKeys) $ do + modifyMVar_ fromKeys $ \fkeys -> do + modifyMVar_ toKeys $ return . M.union fkeys + return M.empty diff --git a/src/Erebos/Storage/Merge.hs b/src/Erebos/Storage/Merge.hs index 9d9db13..a3b0fd7 100644 --- a/src/Erebos/Storage/Merge.hs +++ b/src/Erebos/Storage/Merge.hs @@ -97,13 +97,16 @@ storedGeneration x = doLookup x +-- |Returns list of sets starting with the set of given objects and +-- intcrementally adding parents. generations :: Storable a => [Stored a] -> [Set (Stored a)] generations = unfoldr gen . (,S.empty) - where gen (hs, cur) = case filter (`S.notMember` cur) $ previous =<< hs of + where gen (hs, cur) = case filter (`S.notMember` cur) hs of [] -> Nothing added -> let next = foldr S.insert cur added - in Just (next, (added, next)) + in Just (next, (previous =<< added, next)) +-- |Returns set containing all given objects and their ancestors ancestors :: Storable a => [Stored a] -> Set (Stored a) ancestors = last . (S.empty:) . generations |