{-# LANGUAGE Rank2Types, Trustworthy #-}

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.IORef
import System.IO
import System.FileLock
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad
import Control.Arrow
import Control.Parallel.Strategies
import Data.Columbia.SeekableStream
import Data.Columbia.Mapper

data SeekableWriter m c = SeekableWriter
	{ _putToken :: !(c -> m()), stream :: !(SeekableStream m c) }

instance (Functor m) => Invariant(SeekableWriter m) where
	invmap f g sw = SeekableWriter(_putToken sw.g) (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)) (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)))
	(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) (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)))
	makeGenericStream

putToken :: (Monad m) => c -> ReaderT(SeekableWriter m c) m ()
putToken c = ask>>=lift.(`_putToken` c)

consumeTokenW :: (Monad m) => ReaderT(SeekableWriter m c) m (Maybe c)
consumeTokenW = ask>>=lift._consumeToken.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