diff --git a/columbia.cabal b/columbia.cabal --- a/columbia.cabal +++ b/columbia.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: columbia -version: 0.1.1 +version: 0.1.2 synopsis: Enhanced serialization for media that support seeking. description: Libraries such as binary and cereal support sequential reading and writing but do not rely on any further operations. Many media support seeking in files as well. This library implements a file format that supports random access to data entities by seeking. . @@ -19,6 +19,10 @@ * Changed the invariant surrounding how files are seeked for reading/writing procedures. This permits an additional optimization. See Utils module for details. . * Generalized the interface to Utils locking strategies to arbitrary monads incorporating exceptions and I/O. + . + Release notes for version 0.1.2: + . + * Minor bug fixes. license: BSD3 license-file: LICENSE author: James Candy diff --git a/src/Data/Columbia.hs b/src/Data/Columbia.hs --- a/src/Data/Columbia.hs +++ b/src/Data/Columbia.hs @@ -21,9 +21,6 @@ import Control.Monad.Reader import Generics.Pointless.Functors hiding (Functor,fmap) -rwProxy :: Proxy(PairCtx RWCtx NoCtx) -rwProxy = undefined - -- | Most common idiom of using 'readOneLayer'; reads an entire data structure. readCompoundData :: forall m d. (Monad m, Data(PairCtx RWCtx NoCtx) d) => ReaderT(SeekableStream m Word8) m d readCompoundData = fixT rwProxy(withAddresses #. readOneLayer) diff --git a/src/Data/Columbia/Gc.hs b/src/Data/Columbia/Gc.hs --- a/src/Data/Columbia/Gc.hs +++ b/src/Data/Columbia/Gc.hs @@ -111,12 +111,12 @@ whileM_ (do x2 <- getWriterPosition - return$!n/=x2) + return$!x2 ReaderT(SeekableStream m Word8) m t -> ReaderT(SeekableStream m Word8) m () untilEOF' m = do @@ -127,7 +127,7 @@ whileM_ (do x2 <- getPosition - return$!n/=x2) + return$!x2throwIO ex) - (newhandle,(tmppath,tmpwriter,_,_),((tmppath2,tmpwriter2),newFileSize),len,writer,ref,table) <- catch + (newhandle,(tmppath,tmpwriter,_,_),((tmppath2,tmpwriter2),newFileSize),len,ref,table,writer) <- catch (do putStrLn"Mark phase" newhandle <- openBinaryFile newpath ReadWriteMode @@ -335,11 +334,13 @@ hClose (`hSetFileSize` 0) writeIORef tmpref$!(0,0) + tmptable <- newTable tmppath + let tmpwriter = makeIoWriter tmpref tmptable undefined putStrLn"Fixup phase" len <- fixUpPointers writer tmpwriter(stream tmpwriter2) moreAddresses putStrLn"Sweep phase" sweep writer ref table(stream tmpwriter2) - return$!(newhandle, tmp, tmp2, len, writer, ref, table)) + return$!(newhandle, tmp, tmp2, len, ref, table, writer)) (\(ex::SomeException)->unlockShared l>>throwIO ex) l2 <- switchLocks l withFileLock(path++".lock.writer") Exclusive$ \_->finally @@ -367,6 +368,7 @@ seekWriter 0 writeIntegral addr _fixUpPointers2(stream tmpwriter2) len 0) writer + unmapAll oldtable concludeFileWrite ref table -- Atomically swap the newly swept file in place of the old one. renameFile newpath path) diff --git a/src/Data/Columbia/Mapper.hs b/src/Data/Columbia/Mapper.hs --- a/src/Data/Columbia/Mapper.hs +++ b/src/Data/Columbia/Mapper.hs @@ -26,8 +26,8 @@ -> CInt -> IO (Ptr ()) -foreign import ccall "HsMmap.h &system_io_mmap_file_close" - c_system_io_mmap_file_close :: FunPtr(Ptr () -> IO ()) +foreign import ccall "HsMmap.h system_io_mmap_file_close" + c_system_io_mmap_file_close :: Ptr () -> IO () foreign import ccall unsafe "HsMmap.h system_io_mmap_mmap" c_system_io_mmap_mmap :: Ptr () @@ -57,7 +57,7 @@ newTable path = do mv <- newMVar empty handle <- withCString path$ \p->c_system_io_mmap_file_open p 3{-ReadWriteEx-} - handle' <- newForeignPtr c_system_io_mmap_file_close handle + handle' <- newForeignPtr_ handle return$!Table path$!(mv,handle') fileSize :: FilePath -> Map Pointer (Ptr ()) -> IO Word32 @@ -123,8 +123,10 @@ when(n/=0)$writeIORef errref True) mp #endif mapM(\ptr -> munmapFilePtr ptr 65536) mp + c_system_io_mmap_file_close handle' bool <- readIORef errref when bool$fail"unmapAll: FlushViewOfFile or msync failed" return empty +-- N.B. That this will crash if attempt is made to call twice on the same table object. unmapAll (Table _ (mvar,handle)) = modifyMVar_ mvar$_unmapAll True handle diff --git a/src/Data/Columbia/Utils.hs b/src/Data/Columbia/Utils.hs --- a/src/Data/Columbia/Utils.hs +++ b/src/Data/Columbia/Utils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, Safe #-} +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, Trustworthy #-} -- | 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' @@ -20,7 +20,7 @@ -- 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 +module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper, nFields) where import Data.Word import Data.IORef @@ -30,6 +30,8 @@ import Control.Monad.Trans import Control.Monad.Error import Control.Monad.IO.Class +import Data.Generics.SYB.WithClass.Basics +import Data.Generics.SYB.WithClass.Context import Data.Columbia.Headers import Data.Columbia.Integral import Data.Columbia.CompoundData @@ -52,6 +54,9 @@ seekToStart :: (Monad m) => ReaderT(SeekableStream m Word8) m () seekToStart = seek 0 +rwProxy :: Proxy(PairCtx RWCtx NoCtx) +rwProxy = undefined + -- | 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) @@ -114,8 +119,9 @@ seekWriter 0 local' stream readIntegral seekWriterAtEnd - len2 <- getWriterPosition -- Create slop field. + writeHeader rwProxy(0::Pointer) + len2 <- getWriterPosition writeIntegral addr seekWriter len2 x <- proc