{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module System.IO.RandomAccessFile.Threaded where

import Control.Monad
import Control.Concurrent.STM
import Control.Exception
import qualified Data.Map as M
import qualified Data.ByteString as B
import Data.Int
import System.Posix.Types
import System.Posix.IO
import System.IO
import "unix-bytestring" System.Posix.IO.ByteString
import Text.Printf

import System.IO.RandomAccessFile.Common

data Threaded = Threaded {
    tFile :: Fd
  , tFileSize :: TVar Size
  , tLockSize :: Size
  , tLocks :: TVar FileLocks
  }

instance FileAccess Threaded where
  data AccessParams Threaded = ThreadedParams Size

  initFile (ThreadedParams lockPageSize) path = do
    locks <- atomically $ newTVar M.empty
    let fileMode = Just 0o644
    let flags = defaultFileFlags
    handle <- openFile path ReadWriteMode
    size <- hFileSize handle
    -- printf "Size: %d\n" size
    sizeVar <- newTVarIO (fromIntegral size)
    fd <- handleToFd handle
    -- fd <- openFd path ReadWrite fileMode flags
    return $ Threaded fd sizeVar lockPageSize locks

  readBytes (Threaded fd fileSizeVar lockPageSize locks) offset size = do
    let dataOffset0 = offset `mod` lockPageSize
        pageOffset0 = offset - dataOffset0
        dataOffset1 = (offset + size) `mod` lockPageSize
        pageOffset1 = (offset + size) - dataOffset1
        pageOffsets = [pageOffset0, pageOffset0 + lockPageSize .. pageOffset1]
    underBlockLocks locks ReadAccess pageOffsets $
      fdPread fd (fromIntegral size) (fromIntegral offset)
          `catch` (\(e :: SomeException) -> do
                     printf "pread: offset %d, len %d: %s\n"
                            offset size (show e)
                     throw e)

  writeBytes (Threaded fd fileSizeVar lockPageSize locks) offset bstr = do
      let size = fromIntegral $ B.length bstr
          dataOffset0 = offset `mod` lockPageSize
          pageOffset0 = offset - dataOffset0
          dataOffset1 = (offset + size) `mod` lockPageSize
          pageOffset1 = (offset + size) - dataOffset1
          pageOffsets = [pageOffset0, pageOffset0 + lockPageSize .. pageOffset1]

          pwrite bytes off =
            (fdPwrite fd bytes (fromIntegral off) >> return ())
              `catch` (\(e :: SomeException) ->
                         printf "pwrite: offset %d, len %d: %s\n"
                                offset (B.length bstr) (show e))
      fsize <- atomically $ readTVar fileSizeVar
      underBlockLocks locks WriteAccess pageOffsets $ do
          let delta :: Int64
              delta = max 0 $ fromIntegral (offset + size) - fromIntegral fsize
          when (delta > 0) $
              pwrite (B.replicate (fromIntegral delta) 0) fsize
          pwrite bstr offset
          when (delta > 0) $ do
              -- printf "New size: %d+%d\n" fsize delta
              atomically $ writeTVar fileSizeVar $ fromIntegral (fromIntegral fsize + delta)

  currentFileSize h = do
    let var = tFileSize h
    atomically $ readTVar var
  
  closeFile (Threaded fd _ _ _) = closeFd fd

dfltThreaded :: AccessParams Threaded
dfltThreaded = ThreadedParams 4096