{-# LANGUAGE FlexibleContexts, Safe #-}

-- | Some utility functions. All functions 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'
--   etc.
--
--   Think of a columbia file as just a giant transactional log that is continually being
--   written to; transactions are able to reference other transactions by address, thus
--   constructing data structures; a single address, called the root node address, at the
--   beginning of the file determines the file's nominal mutable state. To keep the file from getting
--   too large, it is garbage collected periodically; bear in mind that calls to the
--   collector have to be programmed to happen manually at a time convenient for your
--   application.
--
--   Please be aware that while you *can* write new addresses over old in the file,
--   this is not compatible with the locking scheme, which is predicated on
--   the assumption that all writing happens to the root block address and appending to
--   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

import Data.Word
import Data.IORef
import System.IO
import System.FileLock
import Control.Monad.Reader
import Control.Monad.Trans
import Control.Exception
import Data.Columbia.Headers
import Data.Columbia.Integral
import Data.Columbia.CompoundData
import Data.Columbia.DualLock
import Data.Columbia.Mapper

{-# INLINE seekToStart #-}
seekToStart :: (Monad m) => ReaderT(SeekableStream m Word8) m ()
seekToStart = do
	seek 0
	addr <- readIntegral
	seek addr

-- | Opens a file for reading, under appropriate locks; seeks to the beginning of the data;
--   runs the procedure.
readFileWrapper :: FilePath -> ReaderT(SeekableStream IO Word8) IO t -> IO t
readFileWrapper path proc = 
	dualLockShared path>>= \l@(DualLockShared _ _ l2) ->
	bracket
	(newTable path)
	unmapAll
	$ \table ->
	fileSizeShim table>>= \sz->
	newIORef(0,sz)>>= \cursor->
	let stream = makeIoStream cursor table l2 in
	finally
		(do
		-- Unlock the writer lock once having retrieved the root block address.
		withFileLock(path++".lock.writer") Exclusive$ \_->runReaderT seekToStart stream
		runReaderT proc stream)
		(unlockShared l)

-- | Opens a file for /writing/, under appropriate locks; seeks to the beginning of the data;
--   runs the procedure; accepts from the procedure an address to write as the new
--   root node address.
writeFileWrapper :: FilePath -> ReaderT(SeekableWriter IO Word8) IO Word32 -> IO()
writeFileWrapper path proc = newIORef undefined>>= \cursor->
	bracket
	(newTable path)
	unmapAll
	$ \table->
	bracket
	(dualLockShared path)
	unlockShared
	$ \_ ->
	withFileLock(path++".lock.writer") Exclusive
	$ \l ->
	runReaderT
	(do
		sz <- lift$fileSizeShim table
		lift$writeIORef cursor$!(0,sz)
		sw <- ask
		seekWriterAtEnd
		len <- getWriterPosition
		when(len == 0)$writeIntegral(0 :: Word32)
		addr <- proc
		seekWriter 0
		writeIntegral addr
	)
	(makeIoWriter cursor table l)

nFields hdr@(_, _, nFields) = if isHeaderArraytype hdr then do
		readIntegral
	else
		return nFields