module Database.Graph.HGraphStorage.FreeList where
import System.IO
import Data.Binary
import Data.Default
import qualified Data.ByteString.Lazy as BS
import Control.Monad.IO.Class (liftIO, MonadIO)
data FreeList a = FreeList
{ flSize :: Integer
, flHandle :: Handle
, flOnEmptyClose :: IO()
}
initFreeList :: (Binary a,MonadIO m) => Integer -> Handle -> IO() -> m (FreeList a)
initFreeList sz h onClose = liftIO $ do
hSeek h SeekFromEnd 0
return $ FreeList sz h onClose
closeFreeList :: (Binary a,MonadIO m) => FreeList a -> m Bool
closeFreeList (FreeList sz h onClose)= liftIO $ do
i <- liftIO $ hTell h
hClose h
if i>=sz
then return True
else do
onClose
return False
addToFreeList :: (Binary a,MonadIO m) => a -> FreeList a -> m ()
addToFreeList b (FreeList _ h _) = liftIO $
BS.hPut h $ encode b
getFromFreeList :: (Binary a,Eq a,Default a,MonadIO m) => FreeList a -> m (Maybe a)
getFromFreeList f@(FreeList sz h _) = do
i <- liftIO $ hTell h
if i>=sz
then do
bs <- liftIO $ do
hSeek h RelativeSeek (sz)
let isz = fromIntegral sz
bs <- BS.hGet h isz
hSeek h RelativeSeek (sz)
return bs
if BS.null bs
then return Nothing
else do
let r = decode bs
if r /= def
then return $ Just r
else getFromFreeList f
else return Nothing