module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper, nFields) 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.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Context
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)
seekToStart :: (Monad m) => ReaderT(SeekableStream m Word8) m ()
seekToStart = seek 0
rwProxy :: Proxy(PairCtx RWCtx NoCtx)
rwProxy = undefined
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
withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart stream
runReaderT proc stream
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
seekWriter 0
local' stream readIntegral
seekWriterAtEnd
writeHeader rwProxy(0::Pointer)
len2 <- getWriterPosition
writeIntegral addr
seekWriter len2
x <- proc
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