{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, Safe #-} -- | Some utility functions. The reader strategies maintain the invariant that the stream is seeked -- to the beginning of a data entity, so that it is safe to use 'readData'/'writeData'/'seekTo' -- etc. The writer strategies maintain the invariant that the writer is seeked at the word -- that should receive the address of the data entity that is written. This allows the writer -- to write eagerly the address and so be tail recursive in some cases. -- -- Think of a columbia file as just a transactional log that is continually being -- written to; transactions are able to reference other transactions by address, thus -- constructing data structures; a single address, called the root node address, at the -- beginning of the file determines the file's nominal mutable state. To keep the file from getting -- too large, it is garbage collected periodically; calls to the -- collector have to be programmed to happen manually at a time convenient for your -- application. -- -- Please be aware that while you *can* write new addresses over old in the file, -- this is not compatible with the locking scheme, which is predicated on -- the assumption that all writing happens to the root block address and appending to -- the end of the file; in other words it is predicated on all data being immutable -- except the root block address. In order to do that, you will have to use your own -- locking scheme to make that work. module Data.Columbia.Utils where import Data.Word import Data.IORef import System.IO import System.FileLock import Control.Monad.Reader import Control.Monad.Trans import Control.Monad.Error import Control.Monad.IO.Class import Data.Columbia.Headers import Data.Columbia.Integral import Data.Columbia.CompoundData import Data.Columbia.DualLock import Data.Columbia.Mapper bracket m f f2 = do x <-m x2 <-catchError(f2 x) (\e->do { f x; throwError e }) f x return x2 withFileLock' path mode = bracket (liftIO$lockFile path mode) (liftIO.unlockFile) ----------------------------------- {-# INLINE seekToStart #-} seekToStart :: (Monad m) => ReaderT(SeekableStream m Word8) m () seekToStart = seek 0 -- | Opens a file for reading, under appropriate locks; seeks to the beginning of the data; -- runs the procedure. For common use, set m := IO. readFileWrapper :: (MonadError e m, MonadIO m) => FilePath -> ReaderT(SeekableStream m Word8) m t -> m t readFileWrapper path proc = liftIO(newIORef undefined)>>= \cursor-> bracket (liftIO$dualLockShared path) (liftIO.unlockShared) $ \l@(DualLockShared _ _ l2) -> bracket (liftIO$newTable path) (liftIO.concludeFileWrite cursor) $ \table -> do liftIO$do sz <-fileSizeShim table writeIORef cursor$!(0,sz) let stream = hoistStream liftIO$makeIoStream cursor table l2 -- Unlock the writer lock once having retrieved the root block address. withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart stream runReaderT proc stream -- | Opens a file for /writing/, under appropriate locks; seeks to the beginning of the data; -- runs the procedure; accepts from the procedure an address to write as the new -- root node address. writeFileWrapper :: (MonadError e m, MonadIO m) => FilePath -> ReaderT(SeekableWriter m Word8) m t -> m t writeFileWrapper path proc = liftIO(newIORef undefined)>>= \cursor-> bracket (liftIO$dualLockShared path) (liftIO.unlockShared) $ \_-> withFileLock'(path++".lock.writer") Exclusive $ \l -> bracket (liftIO$newTable path) (liftIO.concludeFileWrite cursor) $ \table -> let writer = hoistWriter liftIO$makeIoWriter cursor table l in runReaderT (do liftIO$do sz <-fileSizeShim table writeIORef cursor$!(0,sz) sw <- ask seekWriterAtEnd len <- getWriterPosition addr::Word32 <- if len==0 then do writeIntegral(0 :: Word32) return$!0 else do -- For robustness in case of power failures etc. I will special case the root block pointer -- so it writes into a slop field. Once writing is complete, the slop field is copied into -- the actual root block pointer field. That way an interruption to the writing procedure -- does no harm to the file and leaves it in its previous nominal state. seekWriter 0 local' stream readIntegral seekWriterAtEnd len2 <- getWriterPosition -- Create slop field. writeIntegral addr seekWriter len2 x <- proc -- Copy address into root block address field. seekWriter len2 n::Word32 <- local' stream readIntegral seekWriter 0 writeIntegral n return x ) writer nFields hdr@(_, _, nFields) = if isHeaderArraytype hdr then do readIntegral else return nFields