{-# LINE 1 "Sound/MikMod/MReader.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "Sound/MikMod/MReader.hsc" #-}
{-# LANGUAGE EmptyDataDecls #-}
module Sound.MikMod.MReader where

import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.Marshal (allocaBytes)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (toForeignPtr, memcpy)
import System.IO
import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
import Data.Functor ((<$>))
import Control.Monad (when)
import Control.Exception (finally, try)

import Sound.MikMod.Synonyms
import Sound.MikMod.Types


{-# LINE 22 "Sound/MikMod/MReader.hsc" #-}

{-# LINE 23 "Sound/MikMod/MReader.hsc" #-}

data MREADER

type SeekFn = Ptr () -> CLong -> CInt -> IO CInt
type TellFn = Ptr () -> IO CInt
type ReadFn = Ptr () -> Ptr Word8 -> CSize -> IO BOOL
type GetFn  = Ptr () -> IO CInt
type EofFn  = Ptr () -> IO BOOL

foreign import ccall "wrapper" mkSeek :: SeekFn -> IO (FunPtr SeekFn)
foreign import ccall "wrapper" mkTell :: TellFn -> IO (FunPtr TellFn)
foreign import ccall "wrapper" mkRead :: ReadFn -> IO (FunPtr ReadFn)
foreign import ccall "wrapper" mkGet  :: GetFn  -> IO (FunPtr GetFn)
foreign import ccall "wrapper" mkEof  :: EofFn  -> IO (FunPtr EofFn)

-- | To be returned by a readerGet if called at end-of-stream.
eof :: Int
eof = genericEof

genericEof :: Num a => a
genericEof = (-1)
{-# LINE 44 "Sound/MikMod/MReader.hsc" #-}

unmarshalSeekMode :: CInt -> SeekMode
unmarshalSeekMode n = case n of
  (0) -> AbsoluteSeek
{-# LINE 48 "Sound/MikMod/MReader.hsc" #-}
  (1) -> RelativeSeek
{-# LINE 49 "Sound/MikMod/MReader.hsc" #-}
  (2) -> SeekFromEnd
{-# LINE 50 "Sound/MikMod/MReader.hsc" #-}

makeSeek :: (Int -> SeekMode -> IO Int) -> (Ptr () -> CLong -> CInt -> IO CInt)
makeSeek act _ offset whence = fromIntegral <$> act (fromIntegral offset) (unmarshalSeekMode whence)

makeTell :: IO Int -> (Ptr () -> IO CInt)
makeTell act _ = fromIntegral <$> act

makeRead :: (Ptr Word8 -> Int -> IO Bool) -> (Ptr () -> Ptr Word8 -> CSize -> IO BOOL)
makeRead act _ dest len = encodeBool <$> act dest (fromIntegral len)

makeGet :: IO Int -> (Ptr () -> IO CInt)
makeGet act _ = fromIntegral <$> act

makeEof :: IO Bool -> (Ptr () -> IO BOOL)
makeEof act _ = encodeBool <$> act

-- | Allocate a MREADER and populate it with the correct function pointers.
-- Run the action on the MREADER and free it all even if an error occurs.
withMReader :: MReader -> (Ptr MREADER -> IO a) -> IO a
withMReader mr action = allocaBytes ((56)) $ \ptr -> do
{-# LINE 70 "Sound/MikMod/MReader.hsc" #-}
  fp1 <- mkSeek . makeSeek . readerSeek $ mr
  fp2 <- mkTell . makeTell . readerTell $ mr
  fp3 <- mkRead . makeRead . readerRead $ mr
  fp4 <- mkGet  . makeGet  . readerGet  $ mr
  fp5 <- mkEof  . makeEof  . readerEof  $ mr
  ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr fp1
{-# LINE 76 "Sound/MikMod/MReader.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr fp2
{-# LINE 77 "Sound/MikMod/MReader.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr fp3
{-# LINE 78 "Sound/MikMod/MReader.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr fp4
{-# LINE 79 "Sound/MikMod/MReader.hsc" #-}
  ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr fp5
{-# LINE 80 "Sound/MikMod/MReader.hsc" #-}
  finally (action ptr) $ do
    freeHaskellFunPtr fp1
    freeHaskellFunPtr fp2
    freeHaskellFunPtr fp3
    freeHaskellFunPtr fp4
    freeHaskellFunPtr fp5

-- | Create an MReader from a ByteString. 
newByteStringReader :: ByteString -> IO MReader
newByteStringReader bs = do
  let len = BS.length bs
  rpos <- newIORef 0
  return $ MReader
    { readerTell = readIORef rpos
    , readerSeek = \n whence -> case whence of
        AbsoluteSeek -> writeIORef rpos n >> return 0
        RelativeSeek -> modifyIORef rpos (+n) >> return 0
        SeekFromEnd  -> writeIORef rpos (len - n) >> return 0
    , readerRead = \buf n -> do
        i <- readIORef rpos
        let i' = min (i+n) len
        let m = i' - i
        let bs' = BS.take m . BS.drop i $ bs
        let (bytes, _, _) = toForeignPtr bs'
        when (i < len) $ do
          writeIORef rpos i'
          withForeignPtr bytes (\from -> memcpy from buf (fromIntegral m))
        return True
    , readerGet = do
        i <- readIORef rpos
        if (i >= 0 && i < len)
          then do
            modifyIORef rpos (+1)
            return $ fromIntegral (BS.index bs i)
          else return eof
   ,  readerEof = do
        i <- readIORef rpos
        if (i >= 0 && i < len)
          then return False
          else return True
    }


-- | Wrap a Handle so it works like an MReader.
newHandleReader :: Handle -> MReader
newHandleReader h = MReader
  { readerSeek = \n whence -> do
      result <- try (hSeek h whence (fromIntegral n)) :: IO (Either IOError ())
      case result of
        Left _  -> return (-1)
        Right _ -> return 0
  , readerTell = fromIntegral <$> hTell h
  , readerRead = \to n -> do
      result <- try (BS.hGet h n) :: IO (Either IOError ByteString)
      case result of
        Left _   -> return True
        Right bs -> do
          if BS.null bs
            then return False
            else do
              let m = BS.length bs
              let (bytes, _, _) = toForeignPtr bs
              withForeignPtr bytes (\from -> memcpy from to (fromIntegral m))
              return False
  , readerGet = do
      bs <- BS.hGet h 1
      if BS.null bs
        then return eof
        else return (fromIntegral . BS.head $ bs)
  , readerEof = hIsEOF h
  }