diff options
| -rw-r--r-- | src/Erebos/Storage.hs | 39 |
1 files changed, 23 insertions, 16 deletions
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs index cae333d..2cef6c0 100644 --- a/src/Erebos/Storage.hs +++ b/src/Erebos/Storage.hs @@ -122,24 +122,31 @@ openStorage :: FilePath -> IO Storage openStorage path = modifyIOError annotate $ do let versionFileName = "erebos-storage" let versionPath = path </> versionFileName - let writeVersionFile = writeFile versionPath $ storageVersion <> "\n" - - doesDirectoryExist path >>= \case - True -> do - listDirectory path >>= \case - files@(_:_) - | versionFileName `elem` files -> do - readFile versionPath >>= \case - content | (ver:_) <- lines content, ver == storageVersion -> return () - | otherwise -> fail "unsupported storage version" - - | "objects" `notElem` files || "heads" `notElem` files -> do - fail "directory is neither empty, nor an existing erebos storage" - - _ -> writeVersionFile - False -> do + let writeVersionFile = writeFileOnce versionPath $ BLC.pack $ storageVersion <> "\n" + + maybeVersion <- handleJust (guard . isDoesNotExistError) (const $ return Nothing) $ + Just <$> readFile versionPath + version <- case maybeVersion of + Just versionContent -> do + return $ takeWhile (/= '\n') versionContent + + Nothing -> do + files <- handleJust (guard . isDoesNotExistError) (const $ return []) $ + listDirectory path + when (not $ or + [ null files + , versionFileName `elem` files + , (versionFileName ++ ".lock") `elem` files + , "objects" `elem` files && "heads" `elem` files + ]) $ do + fail "directory is neither empty, nor an existing erebos storage" + createDirectoryIfMissing True $ path writeVersionFile + takeWhile (/= '\n') <$> readFile versionPath + + when (version /= storageVersion) $ do + fail $ "unsupported storage version " <> version createDirectoryIfMissing True $ path </> "objects" createDirectoryIfMissing True $ path </> "heads" |