{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators     #-}

module HaskellWorks.Data.FromForeignRegion
  ( FromForeignRegion(..)
  , ForeignRegion
  , mmapFromForeignRegion
  ) where

import Data.Word
import Foreign.ForeignPtr
import HaskellWorks.Data.Product

import qualified Data.ByteString          as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.Vector.Storable     as DVS
import qualified System.IO.MMap           as IO

type ForeignRegion = (ForeignPtr Word8, Int, Int)

-- | Class for datastructures that can be created from a foreign region
class FromForeignRegion a where
  -- | Create a value of type @a from a foreign region.
  fromForeignRegion :: ForeignRegion -> a

instance FromForeignRegion BS.ByteString where
  fromForeignRegion :: ForeignRegion -> ByteString
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size
  {-# INLINE fromForeignRegion #-}

instance FromForeignRegion (DVS.Vector Word8) where
  fromForeignRegion :: ForeignRegion -> Vector Word8
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ForeignPtr Word8 -> Int -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
DVS.unsafeFromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size
  {-# INLINE fromForeignRegion #-}

instance FromForeignRegion (DVS.Vector Word16) where
  fromForeignRegion :: ForeignRegion -> Vector Word16
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ForeignPtr Word16 -> Int -> Int -> Vector Word16
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
DVS.unsafeFromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word16
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset ((Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
  {-# INLINE fromForeignRegion #-}

instance FromForeignRegion (DVS.Vector Word32) where
  fromForeignRegion :: ForeignRegion -> Vector Word32
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ForeignPtr Word32 -> Int -> Int -> Vector Word32
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
DVS.unsafeFromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word32
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset ((Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
  {-# INLINE fromForeignRegion #-}

instance FromForeignRegion (DVS.Vector Word64) where
  fromForeignRegion :: ForeignRegion -> Vector Word64
fromForeignRegion (ForeignPtr Word8
fptr, Int
offset, Int
size) = ForeignPtr Word64 -> Int -> Int -> Vector Word64
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
DVS.unsafeFromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word64
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset ((Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
  {-# INLINE fromForeignRegion #-}

instance  ( FromForeignRegion a
          , FromForeignRegion b
          ) => FromForeignRegion (a :*: b) where
  fromForeignRegion :: ForeignRegion -> a :*: b
fromForeignRegion ForeignRegion
r = ForeignRegion -> a
forall a. FromForeignRegion a => ForeignRegion -> a
fromForeignRegion ForeignRegion
r a -> b -> a :*: b
forall a b. a -> b -> a :*: b
:*: ForeignRegion -> b
forall a. FromForeignRegion a => ForeignRegion -> a
fromForeignRegion ForeignRegion
r
  {-# INLINE fromForeignRegion #-}

mmapFromForeignRegion :: FromForeignRegion a => FilePath -> IO a
mmapFromForeignRegion :: FilePath -> IO a
mmapFromForeignRegion FilePath
filePath = do
  ForeignRegion
region <- FilePath -> Mode -> Maybe (Int64, Int) -> IO ForeignRegion
forall a.
FilePath
-> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr a, Int, Int)
IO.mmapFileForeignPtr FilePath
filePath Mode
IO.ReadOnly Maybe (Int64, Int)
forall a. Maybe a
Nothing
  let !bs :: a
bs = ForeignRegion -> a
forall a. FromForeignRegion a => ForeignRegion -> a
fromForeignRegion ForeignRegion
region
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
bs
{-# INLINE mmapFromForeignRegion #-}