module Data.Columbia.SeekableWriter where
import Foreign.Marshal.Utils
import Foreign.Storable
import Data.Functor.Invariant
import Data.List
import Data.Word
import Data.Char
import Data.Bits
import Data.IORef
import Data.Generics.SYB.WithClass.Basics
import System.IO
import System.FileLock
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Morph
import Control.Monad
import Control.Arrow
import Control.Parallel.Strategies
import Control.Exception
import Data.Columbia.SeekableStream
import Data.Columbia.MyEndianness
import Data.Columbia.Mapper
data SeekableWriter m c = SeekableWriter
{ _putToken :: !(c -> m()), _putIntegralToken :: !(Word32 -> m()), stream :: !(SeekableStream m c) }
instance (Functor m) => Invariant(SeekableWriter m) where
invmap f g sw = SeekableWriter(_putToken sw.g) (_putIntegralToken sw) (fmap f(stream sw))
hoistWriter :: (forall t. m t -> m2 t) -> SeekableWriter m c -> SeekableWriter m2 c
hoistWriter f sw = SeekableWriter(\x -> f(_putToken sw x)) (\x->f(_putIntegralToken sw x)) (hoistStream f(stream sw))
putWord8 :: Handle -> Word8 -> IO()
putWord8 h x = with x(\p -> hPutBuf h p 1)
makeIoWriter :: IORef(Pointer,Pointer) -> Table -> FileLock -> SeekableWriter IO Word8
makeIoWriter ref table lock = SeekableWriter
(\x->readIORef ref>>= \(n,sz)->mapBlock table n>>=(`poke` x)>>(writeIORef ref$!(succ n,max(succ n) sz)))
(\_->fail"makeIoWriter: unimplemented")
(makeIoStream ref table lock)
makeIoWriterChar :: IORef(Pointer,Pointer) -> Table -> FileLock -> SeekableWriter IO Char
makeIoWriterChar ref t = invmap(chr.fromIntegral) (fromIntegral.ord).makeIoWriter ref t
unshimmedIOWriter :: Handle -> FileLock -> SeekableWriter IO Word8
unshimmedIOWriter handle lock = SeekableWriter(putWord8 handle)
(\n->putWord8 handle(fromIntegral$shiftR n 24)>>
putWord8 handle(fromIntegral$shiftR n 16)>>
putWord8 handle(fromIntegral$shiftR n 8)>>
putWord8 handle(fromIntegral n))
(unshimmedIOStream handle lock)
makeGenericWriter :: SeekableWriter(State(Word32, [t], [t])) t
makeGenericWriter = SeekableWriter
(\x -> modify(\(n, ls, ls2) -> using(succ n, x:ls, drop 1 ls2) (evalTuple3 rseq rseq rseq)))
(\_->fail"makeGenericWriter: unimplemented")
makeGenericStream
putToken :: (Monad m) => c -> ReaderT(SeekableWriter m c) m ()
putToken c = ask>>=lift.(`_putToken` c)
putIntegralToken :: (Monad m) => Word32 -> ReaderT(SeekableWriter m c) m ()
putIntegralToken n = ask>>=lift.(`_putIntegralToken` n)
consumeTokenW :: (Monad m) => ReaderT(SeekableWriter m c) m (Maybe c)
consumeTokenW = ask>>=lift._consumeToken.stream
consumeIntegralTokenW :: (Monad m) => ReaderT(SeekableWriter m c) m (Maybe Word32)
consumeIntegralTokenW = ask>>=lift._consumeIntegralToken.stream
getWriterPosition :: (Monad m) => ReaderT(SeekableWriter m c) m Word32
getWriterPosition = ask>>=lift._getPosition.stream
seekWriter :: (Monad m) => Word32 -> ReaderT(SeekableWriter m c) m ()
seekWriter n = ask>>=lift.(`_seek` n).stream
seekWriterAtEnd :: (Monad m) => ReaderT(SeekableWriter m c) m ()
seekWriterAtEnd = ask>>=lift._seekAtEnd.stream
relSeekWriter :: (Monad m) => Word32 -> ReaderT(SeekableWriter m c) m ()
relSeekWriter n = ask>>=lift.runReaderT(relSeek n).stream
local' f x = ask>>=lift.runReaderT x.f
hoistReaderM :: (Monad m, Monad n)
=> (forall t. m t->n t)
-> (forall t. n t->m t)
-> ReaderT(SeekableWriter m c) m u
-> ReaderT(SeekableWriter n c) n u
hoistReaderM f f2 = hoist f.local'(hoistWriter f2)
type PolyTraversalW ctx m d = Proxy ctx
-> (forall a. (Data ctx a) => a -> ReaderT(SeekableWriter m Word8) m ())
-> d -> ReaderT(SeekableWriter m Word8) m ()
hoistPolyTraversalW :: (Monad m, Monad n)
=> (forall t. m t->n t)
-> (forall t. n t->m t)
-> PolyTraversalW ctx m u
-> PolyTraversalW ctx n u
hoistPolyTraversalW f f2 traversal proxy g = hoistReaderM f f2.traversal proxy(\x->hoistReaderM f2 f.g$x)
concludeFileWrite ref table@(Table path _) = do
(_,sz) <- readIORef ref
unmapAll table
bracket
(openBinaryFile path ReadWriteMode)
hClose
(`hSetFileSize` toInteger sz)