module Data.Columbia.Utils (rwProxy, readFileWrapper, writeFileWrapper) 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.Types
import Data.Columbia.Internal.SeekableWriter
import Data.Columbia.Internal.SeekableStream
import Data.Columbia.Internal.Headers
import Data.Columbia.Internal.IntegralTypes
import Data.Columbia.Internal.DualLock
import Data.Columbia.Internal.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 = error"proxy"
snd3(_,x,_) = x
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$makeIoWriter' path l2 True)
(liftIO.snd3)
$ \(writer,_,_) ->
do
let s = stream$hoistWriter liftIO writer
withFileLock'(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart s
runReaderT proc s
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$makeIoWriter' path l True)
(liftIO.snd3)
$ \(writer,_,_) ->
let writer' = hoistWriter liftIO writer in
runReaderT
(do
sw <- ask
seekWriterAtEnd
len <- getWriterPosition
addr::Pointer <- if len==0 then do
writeIntegral(0 :: Pointer)
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::Pointer <- local' stream readIntegral
seekWriter 0
writeIntegral n
return x
)
writer'